• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Combined Multiple Files into one file

Shabbo

Member
Dear Sir,
In my folder I have 30 excel file for per month I wanted to copy data from all files in on excel file.
Start from A 3 to W till last data.
Can you please advice.
 
hi,From the beginning you must move this post to Vba Dep.
You can to use this Code
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)

                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                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
End Sub
https://www.ablebits.com/office-addins-blog/2017/11/08/merge-multiple-excel-files-into-one/
and it have another Code
Code:
Sub MergeWorkbooks()
'Updated by Extendoffice 2019/2/20
Dim xStrPath As String
Dim xStrFName As String
Dim xWS As Worksheet
Dim xMWS As Worksheet
Dim xTWB As Workbook
Dim xStrAWBName As String
On Error Resume Next
xStrPath = "C:\Users\DT168\Desktop\KTE\"
xStrFName = Dir(xStrPath & "*.xlsx")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xTWB = ThisWorkbook
Do While Len(xStrFName) > 0
    Workbooks.Open Filename:=xStrPath & xStrFName, ReadOnly:=True
    xStrAWBName = ActiveWorkbook.Name
    For Each xWS In ActiveWorkbook.Sheets
    xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.Count)
    Set xMWS = xTWB.Sheets(xTWB.Sheets.Count)
    xMWS.Name = xStrAWBName & "(" & xMWS.Name & ")"
    Next xWS
    Workbooks(xStrAWBName).Close
    xStrFName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
Last edited:
Hi !​
HeroFox, next time wait until the thread is moved to the appropriate section like I usually do …​
 
Back
Top