Apologies, this is the full code if needed.
Code
- Sub MergeExcelFiles()
- Dim fnameList, fnameCurFile As Variant
- Dim countFiles, countSheets As Integer
- Dim wksCurSheet As Worksheet
- Dim wbkCurBook, wbkSrcBook As Workbook
- fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
- If (vbBoolean <> VarType(fnameList)) Then
- If (UBound(fnameList) > 0) Then
- countFiles = 0
- countSheets = 0
- Application.ScreenUpdating = False
- Application.Calculation = xlCalculationManual
- Set wbkCurBook = ActiveWorkbook
- For Each fnameCurFile In fnameList
- countFiles = countFiles + 1
- Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
- With wbkSrcBook.Sheets
- Worksheets(1).Select
- countSheets = countSheets + 1
- Worksheets(1).Rows(1).EntireRow.Delete
- Worksheets(1).Range("L:Q, T:X, AC:AC, AF:AV, AX:DI").EntireColumn.Delete
- Worksheets(1).Cells.EntireColumn.AutoFit
- Worksheets(1).Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
- End With
- For Each wksCurSheet In wbkSrcBook.Sheets
- Next
- For Each wksCurSheet In wbkSrcBook.Sheets
- Worksheets(1).Range("L:Q, T:V, Z:AP, AR:DC").EntireColumn.Delete
- Next
- For Each wksCurSheet In wbkSrcBook.Sheets
- Worksheets(1).Cells.EntireColumn.AutoFit
- Next
- wbkSrcBook.Close SaveChanges:=False
- Next
- Application.ScreenUpdating = True
- Application.Calculation = xlCalculationAutomatic
- MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
- End If
- Else
- MsgBox "No files selected", Title:="Merge Excel files"
- End If
- Dim oWs As Worksheet, TargetWS
- Dim rRng As Range
- Dim iX As Integer
- Dim ws As Worksheet
- Dim c As Range
- Sheets(1).Select
- Set TargetWS = Worksheets.Add
- TargetWS.Name = "Combined"
- For Each oWs In ThisWorkbook.Worksheets
- Select Case oWs.Name
- Case "Script", "Combined"
- 'Do nothing
- Case Else
- iX = iX + 1
- ''/// copy headers first time
- If iX = 1 Then
- oWs.Range("A1").CurrentRegion.Copy TargetWS.Range("A1")
- Else
- Set rRng = oWs.Range("A1").CurrentRegion
- Set rRng = rRng.Offset(1, 0).Resize(rRng.Rows.Count - 1, _
- rRng.Columns.Count)
- With TargetWS
- rRng.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
- End With
- End If
- End Select
- Next oWs
- Set ws = ActiveSheet
- With ActiveSheet
- Worksheets(1).Select
- Dim last_row As Long
- last_row = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
- MsgBox (last_row), Title:="Number of transactions"
- End With
- With ActiveSheet
- Worksheets(1).Select
- Dim lastrow As Long
- lastrow = .Cells(.Rows.Count, "L").End(xlUp).Row
- Dim cl As Range
- For Each cl In Range("L2:L" & lastrow)
- cl = "'000" & cl
- Next cl
- Dim myRange As Range
- Set myRange = Range("L2:L" & lastrow)
- myRange.Replace What:="-", Replacement:="", LookAt:=xlPart, _
- SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
- ReplaceFormat:=False
- End With
- With ActiveSheet
- Worksheets(1).Select
- Dim sht As Worksheet
- ThisWorkbook.Worksheets("Combined").Cells.EntireColumn.AutoFit
- End With
- End Sub