vba 一个 Excel 宏，可以使用来自两列的数据向单独的工作表添加和填充新行

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

提问by Matt-Kawa

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

我有一个客户信息表，信息存储在两列的第一张纸上，范围是 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

我在 worksheet2 上有一个空数据库，我想用这些数据填充，从 C5 开始到 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!

我希望能够将宏分配给“添加”按钮，并让宏自动为数据插入一个新行并将其复制，从而使用户能够使用 worksheet1 进行填充！

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.

到目前为止，根据大卫的建议更新。唯一突出的问题是，在运行脚本时，列 M 有行进的蚂蚁，但数据本身并没有复制过来。为了进一步清晰，该表具有数据验证和一些条件格式（一些下拉选项和 Y/N 答案的一些颜色编码），我不确定这是否是一个因素。

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

采纳答案by David Zemens

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

Range("A1").Select

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

Excel 总是将其解释为属于ActiveSheet对象。由于您依赖于该Selection方法，因此很难跟踪正在发生的事情，您需要不断选择新对象以正确确定所有内容的范围等。

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 Mainroutine 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.

运行几次后，我的“数据库”工作表如下图所示。只需调用Main触发其他三个的例程。它将始终在第 6 行中插入一个空白行，并将始终将 F 列和 M 列复制到该新行中。

回答by Necho

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 (e.g begin in A1 to A...) and data in next lines. This organzation will help you to exploit your information using Pivot tables.

我建议您开始使用 Microsoft Excel 中包含的名为“数据表单”的工具。将其添加到菜单中并使用它。一个重要的事情是你需要重新组织你的数据：在第一行把标题（例如从 A1 开始到 A...）和数据放在下一行。该组织将帮助您使用数据透视表来利用您的信息。

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

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

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.

如果您有编程知识，我可以向您展示如何在 Excel 中使用 VBA（for、while 等）做您想做的事。它有点复杂。

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

这里是你需要的代码。但有必要使 sheet2 中的 C5 不为空：

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