Question

我有一系列工作簿，其中包含一系列工作表，我需要将这些工作表合并到一个工作表中（它们都是相同的列）。

我在我的combined（）子组件中有以下片段，我试图用它来访问每个文件，迭代它们，获取每个工作表，然后将每个工作表的内容复制到combined.xlsm文件

我的问题是，我不太关注如何使用我的代码激活工作簿/工作表。我的代码不能正常工作吗？

CombinedWB = "Combined.xlsm"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set FLS = FSO.GetFolder("c:\path\to\files").Files

Row = 1

For Each F In FLS
    CurrentWB = F.Name

    Windows(CurrentWB).Activate

    If CurrentWB <> CombinedWB Then
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets("Combined").Delete
        Application.DisplayAlerts = True

        If Row = 1 Then
            Windows(CombinedWB).Activate

            For Each Cell In ActiveSheet.Range("A3")
                Worksheets("Combined").Range("A" & Row).Value = "Name"
                Worksheets("Combined").Range("B" & Row).Value = "Player"
                Worksheets("Combined").Range("C" & Row).Value = Cell.Value
                Worksheets("Combined").Range("D" & Row).Value = Cell.Offset(0, 1).Value
                Worksheets("Combined").Range("E" & Row).Value = Cell.Offset(0, 2).Value
                Worksheets("Combined").Range("F" & Row).Value = Cell.Offset(0, 3).Value
                Worksheets("Combined").Range("G" & Row).Value = Cell.Offset(0, 4).Value
                Worksheets("Combined").Range("H" & Row).Value = Cell.Offset(0, 5).Value
                Worksheets("Combined").Range("I" & Row).Value = Cell.Offset(0, 6).Value
                Worksheets("Combined").Range("J" & Row).Value = Cell.Offset(0, 7).Value
                Worksheets("Combined").Range("K" & Row).Value = Cell.Offset(0, 8).Value
                Worksheets("Combined").Range("L" & Row).Value = Cell.Offset(0, 9).Value
                Worksheets("Combined").Range("M" & Row).Value = Cell.Offset(0, 10).Value
                Worksheets("Combined").Range("N" & Row).Value = Cell.Offset(0, 11).Value
                Worksheets("Combined").Range("O" & Row).Value = Cell.Offset(0, 12).Value
                Worksheets("Combined").Range("P" & Row).Value = Cell.Offset(0, 13).Value
            Next

            Windows(CurrentWB).Activate

            Row = 2
        End If

        For J = 1 To Sheets.Count
            Player = Sheets(J).Cells(1).Parent.Name
            Injury = Sheets(J).Range("A5").Value
            InjuryDate = Sheets(J).Range("B5").Value
            For Each Cell In Sheets(J).Range("A5:A100")
                Windows(CombinedWB).Activate

                If IsEmpty(Cell.Offset(0, 2).Value) <> True Then
                    Worksheets("Combined").Range("A" & Row).Value = Name
                    Worksheets("Combined").Range("B" & Row).Value = Player
                    Worksheets("Combined").Range("C" & Row).Value = Injury
                    Worksheets("Combined").Range("D" & Row).Value = InjuryDate
                    Worksheets("Combined").Range("E" & Row).Value = Cell.Offset(0, 2).Value
                    Worksheets("Combined").Range("F" & Row).Value = Cell.Offset(0, 3).Value
                    Worksheets("Combined").Range("G" & Row).Value = Cell.Offset(0, 4).Value
                    Worksheets("Combined").Range("H" & Row).Value = Cell.Offset(0, 5).Value
                    Worksheets("Combined").Range("I" & Row).Value = Cell.Offset(0, 6).Value
                    Worksheets("Combined").Range("J" & Row).Value = Cell.Offset(0, 7).Value
                    Worksheets("Combined").Range("K" & Row).Value = Cell.Offset(0, 8).Value
                    Worksheets("Combined").Range("L" & Row).Value = Cell.Offset(0, 9).Value
                    Worksheets("Combined").Range("M" & Row).Value = Cell.Offset(0, 10).Value
                    Worksheets("Combined").Range("N" & Row).Value = Cell.Offset(0, 11).Value
                    Worksheets("Combined").Range("O" & Row).Value = Cell.Offset(0, 12).Value
                    Worksheets("Combined").Range("P" & Row).Value = Cell.Offset(0, 13).Value
                    Row = Row + 1
                End If
            Next
        Next
    End If
Next

修改

这是最终的工作代码（感谢mwolfe02）：

Sub Combine()
    Dim J As Integer
    Dim Sport As String
    Dim Player As String
    Dim Injury As String
    Dim InjuryDate As String
    Dim Row As Integer
    Dim FSO As Object
    Dim FLS As Object
    Dim CurrentWB As String
    Dim CombinedWB As String
    Dim CombinedWBTemp As String
    Dim wb As Workbook
    Dim cwb As Workbook
    Dim ws As Worksheet
    Dim cws As Worksheet

    CombinedWB = "Combined.xlsm"
    CombinedWBTemp = "~$" & CombinedWB

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set FLS = FSO.GetFolder("c:\path\to\files").Files
    Set cwb = Workbooks(CombinedWB)

    Set cws = cwb.Worksheets("Combined")

    cws.Range("A1:Z3200").Clear

    Row = 1

    For Each F In FLS
        CurrentWB = F.Name

        If CurrentWB <> CombinedWB And CurrentWB <> CombinedWBTemp Then
            On Error Resume Next

            Set wb = Workbooks.Open(CurrentWB)

            On Error Resume Next
            If Not wb.Sheets("Combined") Is Nothing Then
                Application.DisplayAlerts = False
                wb.Sheets("Combined").Delete
                Application.DisplayAlerts = True
            End If

            If Row = 1 Then
                For Each Cell In wb.Sheets(1).Range("A3")
                    cws.Range("A" & Row).Value = "Sport"
                    cws.Range("B" & Row).Value = "Player"
                    cws.Range("C" & Row).Value = Cell.Value
                    cws.Range("D" & Row).Value = Cell.Offset(0, 1).Value
                    cws.Range("E" & Row).Value = Cell.Offset(0, 2).Value
                    cws.Range("F" & Row).Value = Cell.Offset(0, 3).Value
                    cws.Range("G" & Row).Value = Cell.Offset(0, 4).Value
                    cws.Range("H" & Row).Value = Cell.Offset(0, 5).Value
                    cws.Range("I" & Row).Value = Cell.Offset(0, 6).Value
                    cws.Range("J" & Row).Value = Cell.Offset(0, 7).Value
                    cws.Range("K" & Row).Value = Cell.Offset(0, 8).Value
                    cws.Range("L" & Row).Value = Cell.Offset(0, 9).Value
                    cws.Range("M" & Row).Value = Cell.Offset(0, 10).Value
                    cws.Range("N" & Row).Value = Cell.Offset(0, 11).Value
                    cws.Range("O" & Row).Value = Cell.Offset(0, 12).Value
                    cws.Range("P" & Row).Value = Cell.Offset(0, 13).Value
                Next

                Row = 2
            End If

            For Each ws In wb.Worksheets
                Player = ws.Cells(1).Parent.Name
                Injury = ws.Range("A5").Value
                InjuryDate = ws.Range("B5").Value
                For Each Cell In ws.Range("A5:A100")
                    If IsEmpty(Cell.Offset(0, 2).Value) <> True Then
                        cws.Range("A" & Row).Value = wb.Name
                        cws.Range("B" & Row).Value = Player
                        cws.Range("C" & Row).Value = Injury
                        cws.Range("D" & Row).Value = InjuryDate
                        cws.Range("E" & Row).Value = Cell.Offset(0, 2).Value
                        cws.Range("F" & Row).Value = Cell.Offset(0, 3).Value
                        cws.Range("G" & Row).Value = Cell.Offset(0, 4).Value
                        cws.Range("H" & Row).Value = Cell.Offset(0, 5).Value
                        cws.Range("I" & Row).Value = Cell.Offset(0, 6).Value
                        cws.Range("J" & Row).Value = Cell.Offset(0, 7).Value
                        cws.Range("K" & Row).Value = Cell.Offset(0, 8).Value
                        cws.Range("L" & Row).Value = Cell.Offset(0, 9).Value
                        cws.Range("M" & Row).Value = Cell.Offset(0, 10).Value
                        cws.Range("N" & Row).Value = Cell.Offset(0, 11).Value
                        cws.Range("O" & Row).Value = Cell.Offset(0, 12).Value
                        cws.Range("P" & Row).Value = Cell.Offset(0, 13).Value
                        Row = Row + 1
                    End If
                Next
            Next

            wb.Close SaveChanges:=True
        End If
    Next

    Windows(CombinedWB).Activate
    Sheets("Combined").Activate
End Sub

Answer 1

使用.Activate方法导致问题。在你想要做的事情中没有必要这样做。使用宏录制器创建的代码充斥着.Activate个调用，但在编写代码时，这些代码通常是个坏主意。

尝试更像这样的事情：

Const CombinedWB As String = "Combined.xlsm"
Dim FSO As Object, FLS As Object, F As Object
Dim wb As Workbook, ws As Worksheet
Dim cwb As Workbook   'This will be our combined workbook'    
Dim cws As Worksheet   'This will be the combined worksheet'    

Set FSO = CreateObject("Scripting.FileSystemObject")

Set FLS = FSO.GetFolder("c:\path\to\files").Files
Set cwb = Workbooks.Open(CombinedWB)
'Use the following line if there is just a single combined worksheet'
'  and it is in the combined workbook'
Set cws = cwb.Worksheets("Combined")


For Each F In FLS
    Set wb = Workbooks.Open(F.Name)

    If F.Name <> CombinedWB Then
        ....
        'Use the following line if each workbook has a combined worksheet'
        Set cws = wb.Worksheets("Combined")  
        For Each ws In wb.Worksheets
            cws.Range("A1") = cws.Range("A1") + ws.Range("A1")
            ....
        Next ws
    End If
    wb.Close SaveChanges:=True
Next F

如何使用Excel VBA激活多个工作簿中的多个工作表中的行数据并将其复制到另一个工作簿的工作表中？

1 个答案: