Public Sub Consolidate()
'Merge files in a specific folder into one master sheet (appended) Dim fName As String, fPath As String, fPathDone As String Dim LR As Long, NR As Long Dim wbData As Workbook, wbMaster As Workbook, wsMaster As Worksheet Dim FileType As String
With Application .ScreenUpdating = False .DisplayAlerts = False End With Set wbMaster = ActiveWorkbook Set wsMaster = ActiveSheet
With wsMaster
'Path and filename (edit this section to suit) MsgBox "Please Highlight The Folder With Files To Consolidate." & Chr(10) & _ "Do Not Navigate Into The Actual Folder Path.", vbOKOnly + vbInformation, "r/Excel" Do With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = "" .AllowMultiSelect = False .Show If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\" FileType = InputBox("Please Confirm File Type", "r/Excel", ".xlsx") Exit Do Else If MsgBox("No Folder Chose, Do You Wish To Abort?", _ vbYesNo + vbCritical, “r/Excel") = vbYes Then Exit Sub End If End With Loop
On Error Resume Next MkDir fPathDone On Error GoTo 0 fName = Dir(fPath & "*" & FileType & "*") NR = 1 Do While Len(fName) > 0 If fName <> ThisWorkbook.Name Then Set wbData = Workbooks.Open(fPath & fName) LR = Range("A" & Rows.Count).End(xlUp).Row Range("A1", ActiveCell.SpecialCells(xlLastCell)).Copy wbMaster.Activate On Error Resume Next Range("B" & NR).PasteSpecial (xlPasteValues) Range("A" & NR & ":" & "A" & (NR + LR)).Value = fName wbData.Close False NR = .Range("B" & .Rows.Count).End(xlUp).Row + 1 End If fName = Dir Loop
End With
ErrorExit: ActiveSheet.Columns.AutoFit
With Application .DisplayAlerts = True .ScreenUpdating = True End With
End Sub
I'm getting a syntax error. I'm doing something wrong. Pardon the silly questions.