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 ofiles").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 ofiles").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
See Question&Answers more detail:
os