I have multiple files I tried to merge in a single one.

I successfully did it thank you to the help of a kind soul. However, now I have to separate the information from each file into single tabs inside the same file.

Code below copy the info from multiple files on x location on my PC, and then paste it all together on one single tab using a loop. I'm trying VBA stops in every loop after paste the info, then create a new tab and paste the info and enter the code and so on.

Option Explicit

Sub Mergebytabs()

Dim wbk1 As Workbook
Set wbk1 = ThisWorkbook
Dim sFolderPath As String
sFolderPath = InputBox("Please introduce the path where files are stored", _
    "Select Files' Path", "Paste path here")
If Len(sFolderPath) = 0 Then Exit Sub
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"

Dim sFilename As String: sFilename = Dir(sFolderPath & "*.xls*")
If Len(sFilename) = 0 Then Exit Sub

Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet)
Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
Dim dfCell As Range
Set dfCell = dws.Range("A1")

Dim swb As Workbook
Dim sws As Worksheet
Dim srg As Range
Dim sFilePath As String
Dim sCount As Long

Dim siteCount As Integer
Dim ilv As Integer
Dim var1 As Worksheet
    
     
Do While Len(sFilename) > 0
Sheets.Add after:=ActiveSheet
Sheets(sCount).Activate
Set swb = Workbooks.Open(sFolderPath & sFilename)
On Error Resume Next ' test if the worksheet exists
        Set sws = swb.Worksheets("Sheet1")
    On Error GoTo 0
    If Not sws Is Nothing Then ' worksheet exists
        sCount = sCount   1
        Set srg = sws.Range("A1").CurrentRegion
        srg.Copy dfCell
        Set dfCell = dfCell.Offset(srg.Rows.Count)
        Set sws = Nothing
        
        siteCount = 0
        For ilv = 1 To siteCount
        var1 = Sheets.Add(after:=Sheets(Worksheets.Count))
        var1.Name = "Sheet_Name_" & CStr(ilv)
        Next ilv
        
        'Else ' worksheet doesn't exist
    End If
    swb.Close SaveChanges:=False
    sFilename = Dir
Loop

CodePudding user response：

Copy from each file to a separate sheet.

Sub MergeByTabs()

    Dim swb As Workbook, sws As Worksheet, srg As Range
    Dim dwb As Workbook, dws As Worksheet
    Dim n As Long, sFolderPath As String, sFilename As String
    
    ' select folder
    With Application.fileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path
        .Title = "Select folder ."
        If .Show = False Then
            MsgBox "Folder not selected"
            Exit Sub
        End If
        sFolderPath = .SelectedItems(1)
    End With
    sFolderPath = sFolderPath & "\"
    
    ' create destination workbook with one sheet
    Set dwb = Workbooks.Add(xlWBATWorksheet)
    
    ' loop through files
    Application.ScreenUpdating = False
    sFilename = Dir(sFolderPath & "*.xls*")
    Do While sFilename <> ""
        
        ' open source workbook
        Set swb = Workbooks.Open(sFolderPath & sFilename, ReadOnly:=True)
        
        ' test if the worksheet exists
        On Error Resume Next
        Set sws = swb.Worksheets("Sheet1")
        On Error GoTo 0
    
        ' if sheet exists then copy data
        If Not sws Is Nothing Then
            
            ' create destination sheet if required
            n = n   1
            If n > dwb.Sheets.Count Then
                Set dws = dwb.Sheets.Add(after:=dwb.Sheets(dwb.Sheets.Count))
            Else
                Set dws = dwb.Sheets(n)
            End If
            dws.Name = "Sheet_Name_" & CStr(n)
            
            ' copy data
            Set srg = sws.Range("A1").CurrentRegion
            srg.Copy dws.Range("A1")
           
        End If
        swb.Close False
        
        ' next file
        sFilename = Dir
    Loop
    Application.ScreenUpdating = True
    
    MsgBox n & " files processed", vbInformation
 
End Sub