How to copy each row from a worksheet into new workbooks?

How to use Excel VBA to activate and copy row data from multiple worksheets in multiple workbooks into another workbook's worksheet?

• 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

• Answer:

  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