Question

我有一个包含大量工作表的工作簿，这些工作表跟踪整个财政年度的预测和实际项目支出。每个工作表中的每一行都有相同的项目。我被要求将每个项目中持有的所有财务数据汇总在一个主电子表格中，并且一直在使用这个宏，这很好用：

Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Master" Then
Sht.Select
Range("A:A").Insert
Range("A91").Formula = "=Mid(Cell(""filename"",B1),Find(""]"",Cell(""filename""))+1,255)"
Range("A91").Copy
Range("A91").PasteSpecial Paste:=xlPasteValues
Range("A91:U91").Copy
Sheets("Master").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sht.Select
Range("A:A").Delete
Else
End If
Next Sht

End Sub

但是，我有大约180行数据，我需要合并到一张表中，我当前不得不手动更改宏中的行号。有没有办法让宏在完成一个后自动移动到下一行？即，一旦它将所有第91行从各个工作簿复制并粘贴到我的主工作簿中，它会重复所有第92行的过程而不必手动更改代码？

从我在线阅读的内容我猜测有可能使用For循环来实现这一点。不幸的是，我对VBA很新，我无法弄清楚如何将其融入我的宏。任何人都可以给我的任何指示都将非常感激！

Answer 1

尝试这样......

Sub CombineData()
Dim shMaster As Worksheet, Sht As Worksheet
Dim LastRow As Long
Application.ScreenUpdating = False
Set shMaster = Sheets("Master")
shMaster.Range("A1").CurrentRegion.Offset(1).Clear
For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> "Master" Then
        With Sht
            LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
            .Columns(1).Insert
            .Range("A2:A" & LastRow).Formula = "=Mid(Cell(""filename"",B1),Find(""]"",Cell(""filename""))+1,255)"
            .Range("A2:A" & LastRow).Value = .Range("A2:A" & LastRow).Value
            .Range("A2:U" & LastRow).Copy shMaster.Range("A" & Rows.Count).End(3)(2)
            .Columns(1).Delete
        End With
    End If
Next Sht
Application.ScreenUpdating = True
End Sub

Answer 2

您声明要执行'复制并将所有第91行从各个工作簿粘贴到我的主工作簿中，它会使用所有第92行重复该过程'但您没有提供终止点。< / p>

这段代码可以满足您的需求（假设您将9999调整为更合理的值），但在一个工作表上执行所有hte操作可能会更好，然后继续执行91以后的所有操作然后全部92等等。

Sub CombineData()
    Dim ws As Worksheet, rw As Long
    For rw = 91 To 9999
        For Each ws In ActiveWorkbook.Worksheets
            With ws
                If .Name <> "Master" Then
                    .Columns("A").EntireColumn.Insert
                    .Cells(rw, "A") = .Name
                    .Cells(rw, "A").Resize(1, 21).Copy _
                        Destination:=Worksheets("Master").Range("A65536").End(xlUp).Offset(1, 0)
                    .Columns("A").EntireColumn.Delete
                End If
            End With
        Next ws
    Next rw

End Sub

将多个工作表中的单行数据合并为一个 - 循环宏？

2 个答案: