如何从excel VBA中的两个不同工作表动态复制数据？

Question

我有两个不同的工作表。我必须从第一张纸上复制第一列（A）。根据第一列中的字符串，从第一列复制数据，从第一张表复制第二列（B），从第二张表复制第二列（B），然后找出两个复制列之间的差异。所有这些数据都将粘贴到新工作表中。重复该过程，从第一张表复制第三列（C），从第二张表复制第三列（C），然后找出差异。重复此过程直到最后一列。

如何使代码动态化，以便在工作表中查找第一列中的数据，然后从其他列中复制数据。

我能够在 WWC 的帮助下使这段代码工作，但是如何在第一列中查找数据然后复制值。

    Sub Macro4()
'
' Macro4 Macro
'

'
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Dim coli As Double
Dim Coli3 As Double
Dim rowy As Double

Dim numCols As Double
Dim startRow As Double
Dim lastRow As Double

startRow = 6 'assuming data starts here
Coli3 = 2 ' start the columns out on ws3

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws3 = ThisWorkbook.Worksheets("Comparison")

Application.ScreenUpdating = False

ws3.Cells.Clear


ws1.Range("A1").EntireColumn.Copy Destination:=ws3.Range("A1")

'Find how many columns there are in sheet1 based on data in row 1
numCols = ws1.Cells(7, Columns.Count).End(xlToLeft).Column
For coli = 2 To numCols
    'Find last Data row in the given column in sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, coli).End(xlUp).Row

    For rowy = 6 To lastRow
        ws3.Cells(rowy, Coli3) = Format(ws1.Cells(rowy, coli).Value, "#,##0") ' copy sheet 1 to the right spot of sheet 3
        ws3.Cells(rowy, Coli3 + 1) = Format(ws2.Cells(rowy, coli).Value, "#,##0") 'copy sheet 2 to the right spot of sheet 3
        'perform calculation and place in the right spot on sheet 3
        If rowy = "6" Then
            ws3.Cells(rowy, Coli3) = ws1.Cells(rowy, coli) & "-Sheet1" ' copy sheet 1 to the right spot of sheet 3
            ws3.Cells(rowy, Coli3 + 1) = ws2.Cells(rowy, coli) & "-Sheet2" 'copy sheet 2 to the right spot of sheet 3
            ws3.Cells(rowy, Coli3 + 2) = "Difference"
        Else
            ws3.Cells(rowy, Coli3) = Format(ws1.Cells(rowy, coli).Value, "#,##0") ' copy sheet 1 to the right spot of sheet 3
            'ws3.Cells(rowy, Coli3).Font.Name = "Arial"
            'ws3.Cells(rowy, Coli3).Font.Size = 8
            ws3.Cells(rowy, Coli3 + 1) = Format(ws2.Cells(rowy, coli).Value, "#,##0") 'copy sheet 2 to the right spot of sheet 3
            'ws3.Cells(rowy, Coli3 + 1).Font.Name = "Arial"
            'ws3.Cells(rowy, Coli3 + 1).Font.Size = 8
            ws3.Cells(rowy, Coli3 + 2) = Format((ws1.Cells(rowy, coli).Value) - (ws2.Cells(rowy, coli).Value), "#,##0")
            'ws3.Cells(rowy, Coli3 + 2).Font.Name = "Arial"
            'ws3.Cells(rowy, Coli3 + 2).Font.Size = 8
        End If

    Next rowy ' move to the next row on ws1, ws2, ws3

    'Since we are placing 3 cols at a time in sheet 3 we increment differently
    Coli3 = Coli3 + 3 '1 becomes 4, 4 becomes 7, 7 becomes 10 and so on


End Sub

Data in the Sheets

Answer 1

好的，要分别在工作表 A 和工作表 B 之间找到每列中每个单元格之间的差异，并将其放在工作表 C 上的相应单元格中，不需要复制，除非您真的希望我们可以配置答案，如果这是一个要求。这是一个在 3 个工作表上运行的宏，将工作表 1 和工作表 2 的差异放在工作表 3 中，逐列、逐个单元格地放置。它决定了数据的列数，它决定了该列中的最后一行数据。工作表 A 和 B 上的列是否总是相同的长度？如果这对您有帮助，请告诉我。

Sub diff_macro()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Dim coli As Double
Dim rowy As Double

Dim numCols As Double
Dim startRow As Double
Dim lastRow As Double

startRow = 1 'assuming data starts in column 1

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws3 = ThisWorkbook.Worksheets("Sheet3")

'Find how many columns there are in sheet1 based on data in row 1
numCols = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

For coli = 1 To numCols
    'Find last Data row in the given column in sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, coli).End(xlUp).Row

    For rowy = 1 To lastRow ' go through each row and perform the difference calculation
        ws3.Cells(rowy, coli) = (ws1.Cells(rowy, coli).Value) - (ws2.Cells(rowy, coli).Value)

    Next rowy ' move to the next row on ws1, ws2, ws3

Next coli 'move to next column on ws1, ws2, ws3


End Sub

干杯，WWC

Answer 2

如果你真的想要 (1) 表 A 值然后 (2) 表 B 值然后 (3) 差异，这里是对复制 A，复制 B，然后执行 Calc 的宏的简单修改，将有一个 a工作表 C 中有很多列，因为您为工作表 A 中的每个列生成 3 个列。但这可以解决问题。如果您有列的标题，则 startRow 应该为 2。您可以运行单独的 for 循环以将标题放在 C 上，或者基于第 1 行编写一个 if 语句，该语句的作用与当前 for 循环中的其余部分不同。

在这里，稍作修改以将列“复制”到工作表 C：

Sub diff_macro()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Dim coli As Double
Dim Coli3 As Double
Dim rowy As Double

Dim numCols As Double
Dim startRow As Double
Dim lastRow As Double

startRow = 1 'assuming data starts in column 1
Coli3 = 1 ' start the columns out on ws3 at column 1

Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Set ws3 = ThisWorkbook.Worksheets("Sheet3")

'Find how many columns there are in sheet1 based on data in row 1
numCols = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

For coli = 1 To numCols
    'Find last Data row in the given column in sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, coli).End(xlUp).Row

    For rowy = 1 To lastRow
        ws3.Cells(rowy, Coli3).Value = ws1.Cells(rowy, coli).Value ' copy sheet 1 to the right spot of sheet 3
        ws3.Cells(rowy, Coli3 + 1).Value = ws2.Cells(rowy, coli).Value 'copy sheet 2 to the right spot of sheet 3
        'perform calculation and place in the right spot on sheet 3
        ws3.Cells(rowy, Coli3 + 2).Value = (ws1.Cells(rowy, coli).Value) - (ws2.Cells(rowy, coli).Value)

    Next rowy ' move to the next row on ws1, ws2, ws3

    'Since we are placing 3 cols at a time in sheet 3 we increment differently
    Coli3 = Coli3 + 3 '1 becomes 4, 4 becomes 7, 7 becomes 10 and so on

Next coli 'move to next column on ws1, ws2

End Sub

希望这些能让你更接近你想要的地方。 干杯，WWC

Answer 3

还有一个答案，这个答案可以帮助您解决尝试的代码。您已经通过定义第一行和最后一行来定义范围内的列，放开整个列的副本。此外，您不需要为副本指定范围（大小），只需选择目标列中的顶部单元格或另一个单元格。这两行工作正常，所以如果你想坚持你的代码，然后相应地修改。这会将工作表 A 上的列的内容复制到工作表 C，很容易为 B 做同样的事情。但它有效。如果您定义范围，则转储整个列副本，我猜整个列副本只需要列号并且不需要范围。

'Find how many columns there are in sheet1 based on data in row 1
numCols = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

For coli = 1 To numCols
    'Find last Data row in the given column in sheet1
    lastRow = ws1.Cells(ws1.Rows.Count, coli).End(xlUp).Row

    ws1.Range(Cells(1, coli), Cells(lastRow, coli)).Copy 'you defined the range you don't need anything else
    ws3.Cells(1, coli).PasteSpecial 'you can place conditions here if you wish

Next coli 'move to next column on ws1, ws2

你去。 -WWC