首页 文章

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

提问于
浏览 次
0

我'借用'并拼凑了各种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 打开时带有黄色高亮显示，所以看起来问题很早，但不知道如何处理它 . 我没有正确地在工作簿之间进行交换，这也可能是一个问题 .

excel vba excel-vba loops

2 回答

  • 0

    好吧，这可能不是最干净的方法，但在我完善它之前，它可以稳定地工作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
    回复于
  • 1

    你不需要 Set ws2，只需 Dim 它 . For Each 执行设置 .

    回复于

相关问题