loop this code for all sheets

[KalilMe]

hi
I have this code it just import data from the first sheet but I want bring all of the data from all sheet in file to one file and one sheet

Sub GetSheets()
'Declare Variables
Dim WorkbookDestination As Workbook
Dim WorkbookSource As Workbook
Dim WorksheetSource As Worksheet
Dim FolderLocation As String
Dim strFilename As String
Dim i As Long
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    'This line will need to be modified depending on location of source folder
    FolderLocation = "C:\Users\"
    
    'Set the current directory to the the folder path.
    ChDrive FolderLocation
    ChDir FolderLocation
    
    'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
    SelectedFiles = Application.GetOpenFilename( _
        FileFilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
    
    'Create a new workbook
    Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(FolderLocation & "\*.xls", vbNormal)
    
        If IsArray(SelectedFiles) Then
        
        For i = LBound(SelectedFiles) To UBound(SelectedFiles)
            Set WorkbookSource = Workbooks.Open(SelectedFiles(i))
            Set WorksheetSource = WorkbookSource.Worksheets(1)
            WorksheetSource.Copy after:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
            WorkbookSource.Close False
            Next i
            
            End If

    WorkbookDestination.Worksheets(1).Delete
      
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

may anybody guide me how add this line to the code

 

[mumps]

For clarification: Do you want to copy all the sheets in WorkbookSource to a single sheet in WorkbookDestination or to separate sheets in WorkbookDestination?

 

[KalilMe]

Do you want to copy all the sheets in WorkbookSource to a single sheet in WorkbookDestination

yes

 

[mumps]

Try:

Sub GetSheets()
    'Declare Variables
    Dim WorkbookDestination As Workbook, WorkbookSource As Workbook, FolderLocation As String, strFilename As String, i As Long, ws As worksheeet
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    'This line will need to be modified depending on location of source folder
    FolderLocation = "C:\Users\"
    'Set the current directory to the the folder path.
    ChDrive FolderLocation
    ChDir FolderLocation
    'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
    SelectedFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
    'Create a new workbook
    Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(FolderLocation & "\*.xls", vbNormal)
    If IsArray(SelectedFiles) Then
        For i = LBound(SelectedFiles) To UBound(SelectedFiles)
            Set WorkbookSource = Workbooks.Open(SelectedFiles(i))
            For Each ws In Sheets
                ws.UsedRange.Copy WorkbookDestination.Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Offset(1)
            Next ws
            WorkbookSource.Close False
        Next i
    End If
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[KalilMe]

it gives error

 

[mumps]

There is a "typo". Change to

ws as workheet

 

[KalilMe]

thanks . as you know each sheet contains the headers in row 1 but I want the headers just in row 1 without repeat the headers many time when merge all of the sheets

 

[mumps]

Try:

Sub GetSheets()
    'Declare Variables
    Dim WorkbookDestination As Workbook, WorkbookSource As Workbook, FolderLocation As String, strFilename As String, i As Long, ws As Worksheet, x As Long
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    'This line will need to be modified depending on location of source folder
    FolderLocation = "C:\Users\"
    'Set the current directory to the the folder path.
    ChDrive FolderLocation
    ChDir FolderLocation
    'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
    SelectedFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)
    'Create a new workbook
    Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(FolderLocation & "\*.xls", vbNormal)
    If IsArray(SelectedFiles) Then
        For i = LBound(SelectedFiles) To UBound(SelectedFiles)
            Set WorkbookSource = Workbooks.Open(SelectedFiles(i))
            For Each ws In Sheets
                If x = 0 Then
                    ws.UsedRange.Copy WorkbookDestination.Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Offset(1)
                    x = 1
                Else
                    ws.UsedRange.Offset(1).Copy WorkbookDestination.Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Offset(1)
                End If
            Next ws
            WorkbookSource.Close False
            x = 0
        Next i
    End If
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

 

[KalilMe]

great! just last thing the code creates a new workbook when run the code . I don't want that .

 

[mumps]

What is the destination workbook?