如何使用Excel VBA激活並將行數據從多個工作簿中的多個工作表複製到另一個工作簿的工作表中？

-1

我有一系列工作簿，其中包含一系列工作表，其中我需要將這些工作表合併到一個工作表（它們都是相同的列）。如何使用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

來源

2011-03-10 Jared Farrish

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

上的問題

來源

2011-03-10 15:45:55 mwolfe02

@ 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激活並將行數據從多個工作簿中的多個工作表複製到另一個工作簿的工作表中？

回答

相關問題