简体   繁体   中英

An Excel macro that can add and populate a new row to a separate worksheet using data from two columns

What I am trying to do is this.

I have a customer information form, with information stored on the 1st sheet in two columns, the range is F5:F38,M5:M33

I have an empty database on worksheet2 that i'd like to populate with this data, Starting on C5 across to BM5

I want to be able to assign the macro to an 'add' button, and have the macro automatically insert a new row for the data and copy it across, enabling users to use worksheet1 to populate!

Matt

Updated from David's advice thus far. The only outstanding issue is that when running the script, Column M has the marching ants but the data itself does not copy across. For further clarity, the sheet has data validation and some conditional formatting (a few drop-down options and some colour coding on Y/N answers), i'm not sure if this is a factor.

Dim wsDB As Worksheet
Dim wsInfo As Worksheet

Sub Main()
Set wsDB = Worksheets("DATABASE")
Set wsInfo = Worksheets("INPUT")

insertnewrow
addcolumnf
addcolumnm

End Sub
Sub insertnewrow()
'
' insertnewrow Macro

    wsDB.Rows("6:6").Insert _
        Shift:=xlDown, _
        CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Sub addcolumnf()
'
' addcolumnf Macro

    wsInfo.Range("F5:F38").Copy
    wsDB.Range("C6:AJ6").PasteSpecial _
            Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True


End Sub
Sub addcolumnm()
'
' addcolumnm Macro
'
    Application.CutCopyMode = False
    wsInfo.Range("M5:M33").Copy
    wsDB.Range("AK6:BM6").PasteSpecial _
            Paste:=xlAllExceptBorders, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=True

End Sub

I suggest you get started with a tool included in Microsoft Excel called "Data Form". Add it into the menu and use it. An important thing is that you need reorganize your data: In the first line put the header (eg begin in A1 to A...) and data in next lines. This organzation will help you to exploit your information using Pivot tables.

If you prefer use a button to call the form, you can use this macro assigned to a button:

Sub Macro1() Sheets("worksheet1").Select Range("A1").Select ActiveSheet.ShowDataForm End Sub

This link will show you more about that tool:

http://www.homeandlearn.co.uk/excel2007/excel2007s8p1.html

If you have knowledge of programming I could show you how to do what you want using VBA in Excel (for, while, etc). It is a little more complicated.

Here the code that you need. but is necesary that C5 in sheet2 is nt empty:

Sub Macro6()
Dim Count As Long

'Copy first column
Sheets("worksheet1").Select
Range("F5:F38").Select
Selection.Copy

'Search the next row empty
Sheets("worksheet2").Select
Range("C5").Select
Selection.End(xlDown).Select
Count = ActiveCell.Cells.Row + 1

'Copy in the next empty row
Range("C" & Count).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

'Again with the next column
'Copy second column
Sheets("worksheet1").Select
Range("M5:M33").Select
Application.CutCopyMode = False
Selection.Copy

'Copy in the same row in the second sheet
Sheets("worksheet2").Select
Range("AK" & Count).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

End Sub

OK. I am not exactly sure what your problem is but likely related to unqualified object variables. When you do something like:

Range("A1").Select

Excel always interprets that as belonging to the ActiveSheet object. Since you are relying on the Selection method, it becomes difficult to track what is happening, you need to constantly select new objects to scope everything properly, etc.

This can be avoided by revising your code to something like:

Dim wsDB As Worksheet
Dim wsInfo As Worksheet

Sub Main()
Set wsDB = Worksheets("Database")
Set wsInfo = Worksheets("Sheet3") 'MODIFY AS NEEDED

insertnewrow
addcolumnf
addcolumnm

End Sub
Sub insertnewrow()
'
' insertnewrow Macro

    wsDB.Rows("6:6").Insert _
        Shift:=xlDown, _
        CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Sub addcolumnf()
'
' addcolumnf Macro

    wsInfo.Range("F5:F38").Copy
    wsDB.Range("C6:AJ6").PasteSpecial _
            Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True


End Sub
Sub addcolumnm()
'
' addcolumnm Macro
'
    Application.CutCopyMode = False
    wsInfo.Range("M5:M33").Copy
    wsDB.Range("AK6:BM6").PasteSpecial _
            Paste:=xlAllExceptBorders, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=True

End Sub

After I run this a few times, my "Database" worksheet looks like the image below. Simply call the Main routine which fires the other three. It will always insert a blank row in row 6, and it will always copy columns F and M in to that new row.

在此处输入图片说明

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM