Question

我借用了'并拼凑了各种SO和其他论坛帖子中的代码，以便在主工作簿中创建一个Excel VBA脚本，该脚本将：

擦除原始目标单元格'clean'
要求用户选择源工作簿
从源
在下一个打开的行中粘贴到主工作簿

此代码功能 - 仅适用于一个源工作表 - 如下所示：

Sub Copy_Data_Test()

Range("A2:N750").ClearContents

'Set primary variables
Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long

Set WS = Worksheets("SIS Agregate")
With WS
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With

Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant

'Set copy destination
Set wb = ActiveWorkbook

'Request to open copy source
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)
'Exit if no copy source chosen
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

'Set copy source variable
Set wb2 = ActiveWorkbook

'Select range to copy
wb2.Worksheets("032_Laguna_Hills").Select
Range("A2:M100").Select
Selection.Copy

'Paste in Copy Destination
wb.Activate
wb.Worksheets("SIS Agregate").Range("A" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

我的目标是让这个循环通过约。 50个工作表。为此，我发现suggestion from this SO post使用For Each / Next循环来循环工作表并复制相同范围的单元格。

我正在尝试按照建议包装处理代码，但没有成功。宏在遇到此循环时停止。我做错了什么或我把这个代码放错了地方？（我在打开源工作簿之后只包含了更改的代码）。

'Set copy source variable
Set wb2 = ActiveWorkbook
Set ws2 = Worksheet

'Select range to copy
For Each ws2 In wb2.Sheets
Range("A2:M100").Select
Selection.Copy

'Paste in Copy Destination
wb.Activate
wb.Worksheets("SIS Agregate").Range("A" & LastCellRowNumber).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
Next ws2

End Sub

未提供错误文字; VBA调试器在Set ws2 = Worksheet或For Each ws2 IN wb2.Sheets处以黄色突出显示打开，因此问题很早就出现了，但不知道该怎么做。我也担心我没有正确地交换书籍，这也可能是个问题。

Answer 1

好吧，这可能不是最干净的方法，但在我完善它之前，它可以稳定地工作50张。我使用上面的建议来正确迭代循环中的最后一行。

Sub Copy_Box_Data()

Range("A2:N5000").ClearContents

Dim WS As Worksheet
Dim LastCell As Range
Dim LastCellRowNumber As Long

Set WS = Worksheets("SIS Agregate")
With WS
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With

Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant

Set wb = ActiveWorkbook

vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)

If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile

Set wb2 = ActiveWorkbook

For Each sh In wb2.Worksheets
    sh.Range("A2:M200").Copy
    wb.Activate
    wb.Worksheets("SIS Agregate").Range("A" & LastCellRowNumber).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Set LastCell = wb.ActiveSheet.Cells(wb.ActiveSheet.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
Next

End Sub

Answer 2

您不需要Set ws2，只需Dim它。 For Each执行设置。

循环Excel VBA脚本通过工作表不起作用

2 个答案: