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

问题描述：

我有一系列工作簿，其中包含一系列工作表，其中我需要将这些工作表合并到一个工作表（它们都是相同的列）。如何使用Excel VBA激活并将行数据从多个工作簿中的多个工作表复制到另一个工作簿的工作表中？

我从我的联合（）子，我试图用来访问每个文件，迭代它们，获取每个工作表内，然后将每个工作表的内容复制到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

Downvote是报应与此相关的问题：http://stackoverflow.com/questions/12131139/convert-this-formula-to-php – 2012-08-26 15:48:59

答

你的问题可以通过使用.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

上的问题

@ mwolfe02 - 他们为什么不好主意？（只是想知道）我想我没有看到我可以如何调用工作表（“组合”），并从同一行上的原始工作表中获取当前单元格值。这是我卡住的地方。 – 2011-03-10 15:51:39

他们本身并不坏。遇到麻烦的地方在于，您依靠“Activate”方法将Excel置于特定状态（即激活某个表单或工作簿时）。当用户在正在运行的进程中激活不同的工作簿/工作表时，这几乎肯定会导致问题。现在突然你的代码认为它在工作表“A”上工作（因为这是它激活的），但是用户点击工作表“B”，所以你编程发生在工作表“A”上的所有东西都是在工作表“B”。 – mwolfe02 2011-03-10 16:00:04

我已更新我的答案以解决您的其他问题。 – mwolfe02 2011-03-10 16:02:31

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

相关推荐