如何使用Excel VBA将多个工作簿中的多个工作表中的行数据激活并复制到另一个工作簿的工作表中？ [英] How to use Excel VBA to activate and copy row data from multiple worksheets in multiple workbooks into another workbook's worksheet?

问题描述

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

我从下面的组合（）子代码中，我试图使用它来访问每个文件，迭代它们，获取每个工作表，然后将每个工作表的内容复制到combine.xlsm文件。 / p>

我的问题是，我不太在乎如何用我的代码激活工作簿/工作表。我的代码是否不工作？

  CombinedWB =Combined.xlsm
 
设置FSO = CreateObject（Scripting.FileSystemObject）
 
设置FLS = FSO.GetFolder（c：\path\to\files）。文件
 
 Row = 1 
 
对于每个F在FLS 
 CurrentWB = F.Name 
 
 Windows（CurrentWB）.Activate 
 
如果CurrentWB& ; CombinedWB然后
 On Error Resume Next 
 Application.DisplayAlerts = False 
工作表（Combined）。删除
 Application.DisplayAlerts = True 
 
如果Row = 1然后
 Windows（CombinedWB）.Activate 
 
 ActiveSheet.Range（A3）中的每个单元格
工作表（组合）。范围（A& ; Row）.Value =Name
工作表（Combined）。Range（B& Row）.Value =Player
工作表（Combined）。Range & Row）.Value = Cell.Value 
工作表（Combined）。Range（D& Row）.Value = Cell.Offset（0，1）.Value 
 Worksheets （组合））Range（E& Row）.Value = Cell.Offset（0,2）.Value 
 Worksheets（Combined）。Range（F& Row）.Value = Cell.Offset（0，3）.Value 
工作表（Combined）。Range（G& Row）.Value = Cell.Offset（0，4）.Value 
 Worksheets有限公司mbined）。范围（H&行）.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 
工作表（Combined）。Range（K& Row ）.Value = Cell.Offset（0,8）.Value 
 Worksheets（Combined）。Range（L& Row）.Value = Cell.Offset（0,9）.Value 
工作表（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 
工作表（Combined）。Range（P& Row）.Value = Cell.Offset（0，13）.Value 
 Next 
 
 Windows（CurrentWB）.Activate 
 
 Row = 2 
 End If 
 
对于J = 1 To Sheets.Count 
玩家=表（J）.Cells（1）.Parent.Name 
伤害=表（J）.Range（A5）。值
 InjuryDate = Sheets（J）.Range（B5 ）.Value 
对于表格中的每个单元格（J）.Range（A5：A100）
 Windows（CombinedWB）.Activate 
 
如果IsEmpty（Cell.Offset（0 ，2）.Value）< True然后
工作表（Combined）。Range（A& Row）.Value = Name 
工作表（Combined）。Range（B& Row）.Value = Player 
工作表（Combined）。Range（C& Row）.Value = Injury 
工作表（Combined）。Range（D& Row）.Value = InjuryDate 
 Worksheets（Combined）。Range（E& Row）.Value = Cell.Offset（0,2）.Value 
工作表（Combined）。Range（F& Row ）.Value = Cell.Offset（0，3）.Value 
工作表（Combined）。Range（G& Row）.Value = Cell.Offset（0，4）.Value 
工作表（Combined）。Range（H& Row）.Value = Cell.Offset（0，5）.Value 
工作表（Combined）。Range（I& Row） .Value = Cell.Offset（0,6）.Value 
工作表（Combined）。Range（J& Row）.Value = Cell.Offset（0，7）.Value 
工作表（组合拳 ）.Range（K&行）.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 
工作表（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 
下一个
结束如果
下一个
  

编辑

这是最后的工作代码（感谢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作为工作簿
 Dim cwb As Workbook 
 Dim ws As Worksheet 
 Dim cws As Worksheet 
 
 CombinedWB =Combined.xlsm
 CombinedWBTemp =〜$ & CombinedWB 
 
设置FSO = CreateObject（Scripting.FileSystemObject）
设置FLS = FSO.GetFolder（c：\path\to\files）。文件
 set cwb = Workbooks（CombinedWB）
 
设置cws = cwb.Worksheets（Combined）
 
 cws.Range（A1：Z3200）。清除
 
行= 1 
 
对于每个F在FLS 
 CurrentWB = F.Name 
 
如果CurrentWB<>组合的WB和CurrentWB CombinedWBTemp然后
 On Error Resume Next 
 
设置wb = Workbooks.Open（CurrentWB）
 
关于错误简历Next 
如果不是wb.Sheets（ 
 Application.DisplayAlerts = False 
 wb.Sheets（Combined）。删除
 Application.DisplayAlerts = True 
 End If 
 
如果Row = 1然后
对于每个单元格在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&行）.Value = Cell.Offset（0，4）.Value 
 cws.Range（H&行）.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 
 
对于每个ws在wb.Worksheets 
 Player = ws.Cells（1）.Parent.Name 
 Injury = ws。范围（A5）。价值
 InjuryDate = ws.Range（B5）。价值
对于每个单元格在ws.Range（A5：A100）
如果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&行）.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 
行=行+ 1 
结束如果
下一个
下一个
 
 wb.Close SaveChanges：= True 
结束如果
下一个
 
 Windows（CombinedWB）。激活
表格（Combined）。激活
 End Sub 
  

解决方案

您的问题是由于使用 .Activate 方法引起的。在你想要做的事情上没有必要。使用宏记录器创建的代码散布着 .Activate 调用，但是自己编写代码时通常是一个坏主意。

  Const CombinedWB As String =Combined.xlsm
 Dim FSO As对象，FLS作为对象，F作为对象
 Dim wb As Workbook，ws As Worksheet 
 Dim cwb As Workbook'这将是我们的组合工作簿'
 Dim cws As Worksheet'这将是组合工作表'
 
设置FSO = CreateObject（Scripting.FileSystemObject）
 
设置FLS = FSO.GetFolder（c：\path\to\files ）.Files 
设置cwb = Workbooks.Open（CombinedWB）
'如果只有一个组合工作表'
'，并且它在组合工作簿$ b $中，则使用以下行b设置cws = cwb.Worksheets（组合）
 
 
对于每个F在FLS 
设置wb = Workbooks.Open（F.Name）
 
如果F.Name<>组合WB然后
 .... 
'如果每个工作簿都有一个组合工作表'
设置cws = wb.Worksheets（组合），则使用以下行
对于每个ws In wb.Worksheets 
 cws.Range（A1）= cws.Range（A1）+ ws.Range（A1）
 .... 
下一个ws 
结束如果
 wb.Close SaveChanges：= True 
下一个F 
  

I have a series of workbooks, containing a series of worksheets, in which I am needing to consolidate those worksheets into one worksheet (they are all identical columns).

I have the below snippet from my combined() sub that I'm trying to use to access each file, iterate over them, get each worksheet inside, and then copy the contents of each worksheet over to the combined.xlsm file.

My problem is, I'm not quite following how I should activate the workbooks/worksheets with my code. Is my code just not going to work?

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

EDIT

Here is the final working code (thanks to 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

解决方案

Your problems are caused by using the .Activate method. There is no need for that in what you are trying to do. Code created using the macro recorder is littered with .Activate calls, but they are generally a bad idea when writing code yourself.

Try something more like this:

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将多个工作簿中的多个工作表中的行数据激活并复制到另一个工作簿的工作表中？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！