10 Workbooks into 1 - Project/Event task list

[LoneRanger]

So I'm looking to combine about ten fixed work books where all the sheets are with the same name called "events" and I'm looking for it to basically start on row 7 and if there's a value in Column A copy that row to a new workbook. Once all event lists have been copied from each workbook I would like to sort them out by start date which is column D.

The goal is to gather everyone's events and sort them out chronologically ascending starting from the earliest date to the most future date.

Finally I would like to be able to update the same sheet by re-polling the information.

Any help is appreciated.

 

[JLGWhiz]

If all ten workbooks are in the same folder (directory) along with your consolidated workbook and these are the only excel files in that directory, then you could use the following code.

Sub consolidate()
Dim wb As Workbook, fName As String, fPath As String, sh As Worksheet
Set sh = ThisWorkbook.Sheets(1) 'Assumes consolidated sheet will be first sheet in the workbook, if not change to sheet name.
fPath = ThisWorkbook.Path
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & "*.xl*")
sh.Cells.Clear
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            If sh.Cells(1, 1) = "" Then wb.Sheets("events").Rows("1:6").Copy sh.Range("A1")
            wb.Sheets("events").UsedRange.Offset(7).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            wb.Close False
        End If
        fName = Dir
    Loop
End Sub

The code should be pasted into your standard code module 1. If this does the consolidation for you, you can use the Excel sort button on the ribbon.

 

[LoneRanger]

Thanks JLGWhiz for helping however this isn't what I was looking for. Basically what I wanted to do was open a new workbook run the macro and it would go through each file and pull out all the event sheets from each workbook and start copying rows if there was data in Column "A" after Row 7 starting on row 2 of the new workbook as I would have to put all the headers back which is the same in all workbooks on Row 6. Any help is appreciated.

Is there a way to pick out which workbooks? Make a selection?

If all ten workbooks are in the same folder (directory) along with your consolidated workbook and these are the only excel files in that directory, then you could use the following code.

Sub consolidate()
Dim wb As Workbook, fName As String, fPath As String, sh As Worksheet
Set sh = ThisWorkbook.Sheets(1) 'Assumes consolidated sheet will be first sheet in the workbook, if not change to sheet name.
fPath = ThisWorkbook.Path
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & "*.xl*")
sh.Cells.Clear
    Do While fName <> ""
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            If sh.Cells(1, 1) = "" Then wb.Sheets("events").Rows("1:6").Copy sh.Range("A1")
            wb.Sheets("events").UsedRange.Offset(7).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            wb.Close False
        End If
        fName = Dir
    Loop
End Sub

The code should be pasted into your standard code module 1. If this does the consolidation for you, you can use the Excel sort button on the ribbon.

 

[JLGWhiz]

This will allow the user to select a workbook to open. The code displays the default directory for Excel files on the user's computer. The user simply selects the file they want to work with in the dialogue box then clicks "Open". The code then opens that workbook finds sheet "events" and if there is data in A7, Will copy everything from row A7 down on that sheet to the next available row on sheet 1 of the new workbook, starting with row 2. The user will be prompted to repeat the process for as many workbooks as needed and can terminate the process by clicking the 'No' button when prompted.

Sub consolidate()
Dim wb As Workbook, newWB As Workbook, fName As String, sh As Worksheet, ans As Variant
Set newWB = Workbooks.Add
Set sh = newWB.Sheets(1) 'Assumes consolidated sheet will be first sheet in the workbook, if not change to sheet name.
Repeat:
fName = Application.GetOpenFilename("Excel Files (*.xl*),*.xl*", , "Select Excel file...")
    If fName = False Then Exit Sub
    Set wb = Workbooks.Open(fName)
        If wb.Sheets("events").Cells(7, 1) <> "" Then
            wb.Sheets("events").UsedRange.Offset(7).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
        End If
        wb.Close False
        ans = MsgBox("Do you want to open another workbook?", vbYesNo + vbQuestion, "CONTINUE")
        If ans = vbYes Then GoTo Repeat:
End Sub

 

[LoneRanger]

I think I failed to explain my intent correctly. If there's a value in Column "A" starting on Row7 copy the row otherwise skip the row and go to the next is what I was looking for. Continue to do this until the sheet is done. Go to the next workbook with the same name and do the same until all is copied into a single workbook then as you said I can sort it out by date in the ribbon.

This will allow the user to select a workbook to open. The code displays the default directory for Excel files on the user's computer. The user simply selects the file they want to work with in the dialogue box then clicks "Open". The code then opens that workbook finds sheet "events" and if there is data in A7, Will copy everything from row A7 down on that sheet to the next available row on sheet 1 of the new workbook, starting with row 2. The user will be prompted to repeat the process for as many workbooks as needed and can terminate the process by clicking the 'No' button when prompted.

Sub consolidate()
Dim wb As Workbook, newWB As Workbook, fName As String, sh As Worksheet, ans As Variant
Set newWB = Workbooks.Add
Set sh = newWB.Sheets(1) 'Assumes consolidated sheet will be first sheet in the workbook, if not change to sheet name.
Repeat:
fName = Application.GetOpenFilename("Excel Files (*.xl*),*.xl*", , "Select Excel file...")
    If fName = False Then Exit Sub
    Set wb = Workbooks.Open(fName)
        If wb.Sheets("events").Cells(7, 1) <> "" Then
            wb.Sheets("events").UsedRange.Offset(7).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
        End If
        wb.Close False
        ans = MsgBox("Do you want to open another workbook?", vbYesNo + vbQuestion, "CONTINUE")
        If ans = vbYes Then GoTo Repeat:
End Sub

 

[LoneRanger]

*Bump*