Trying to create a file with certain info in separate tabs - excel

Question

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

Answer 1

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