loop this code for all sheets

KalilMe

Board Regular
Joined
Mar 5, 2021
Messages
122
Office Version
  1. 2016
Platform
  1. Windows
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
VBA Code:
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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,624
Will that file also contain the macro? What is the file extension (xlsx, xlsm)?
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,624
This macro assumes that the destination sheet (Sheet1) exists in the workbook containing the macro.
VBA Code:
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
    Set WorkbookDestination = ThisWorkbook
    '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
    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(WorkbookDestination.Sheets(1).Rows.Count, "A").End(xlUp).Offset(1)
                    x = 1
                Else
                    ws.UsedRange.Offset(1).Copy WorkbookDestination.Sheets(1).Cells(WorkbookDestination.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
 
Solution

KalilMe

Board Regular
Joined
Mar 5, 2021
Messages
122
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

thanks , but it shouldn't copy to the bottom repeatedly . it just replace new data for old data when run the macro every time
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,624
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of at least two source sheets. Alternately, you could upload a copy of at least 2 source files to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).
 

KalilMe

Board Regular
Joined
Mar 5, 2021
Messages
122
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

this is what I got when I run macro continuously
INVE1.xlsx
ABCDE
1ITEMGOODSTYPEPRQTY
21FRIUTBANANASO200
32VEGTIBLETOMATOEG100
43FOOD1TUNE160GSP150
54FOOD2TUNE180GTH250
65FOOD3CHEESE CHEEDERNE300
76FRUTAPPLETU120
87VEGTIBLEPOTATOGR100
99FOOD5BISCUITS SWSW150
1010FOOD1TUNE160GIN140
1111FOOD2TUNE180GTW130
1212FOOD3CHEESE MOZZIRELAIT300
1313FOOD5BISCUITS SWSS250
1414FRUTAPPLEIT120
1515VEGETIBLEONIONPO100
1616VEGETIBLEONIONLOC101
1717FOOD6BISCUITS SWBR250
1818FOOD7BISCUITS SWBR251
1919FOOD8BISCUITS SWBR252
20ITEMGOODSTYPEPRQTY
211FRIUTBANANASO200
222VEGTIBLETOMATOEG100
233FOOD1TUNE160GSP150
244FOOD2TUNE180GTH250
255FOOD3CHEESE CHEEDERNE300
266FRUTAPPLETU120
277VEGTIBLEPOTATOGR100
289FOOD5BISCUITS SWSW150
2910FOOD1TUNE160GIN140
3011FOOD2TUNE180GTW130
3112FOOD3CHEESE MOZZIRELAIT300
3213FOOD5BISCUITS SWSS250
3314FRUTAPPLEIT120
3415VEGETIBLEONIONPO100
3516VEGETIBLEONIONLOC101
3617FOOD6BISCUITS SWBR250
3718FOOD7BISCUITS SWBR251
3819FOOD8BISCUITS SWBR252
39ITEMGOODSTYPEPRQTY
401FRIUTBANANASO200
412VEGTIBLETOMATOEG100
423FOOD1TUNE160GSP150
434FOOD2TUNE180GTH250
445FOOD3CHEESE CHEEDERNE300
456FRUTAPPLETU120
467VEGTIBLEPOTATOGR100
479FOOD5BISCUITS SWSW150
4810FOOD1TUNE160GIN140
4911FOOD2TUNE180GTW130
5012FOOD3CHEESE MOZZIRELAIT300
5113FOOD5BISCUITS SWSS250
5214FRUTAPPLEIT120
5315VEGETIBLEONIONPO100
5416VEGETIBLEONIONLOC101
5517FOOD6BISCUITS SWBR250
5618FOOD7BISCUITS SWBR251
5719FOOD8BISCUITS SWBR252
SH1


and this is what I want when run the macro repeatedly . if there is data should clear and replace the data again when merge for all sheets without copy to the bottom
INVE1.xlsx
ABCDE
39ITEMGOODSTYPEPRQTY
401FRIUTBANANASO200
412VEGTIBLETOMATOEG100
423FOOD1TUNE160GSP150
434FOOD2TUNE180GTH250
445FOOD3CHEESE CHEEDERNE300
456FRUTAPPLETU120
467VEGTIBLEPOTATOGR100
479FOOD5BISCUITS SWSW150
4810FOOD1TUNE160GIN140
4911FOOD2TUNE180GTW130
5012FOOD3CHEESE MOZZIRELAIT300
5113FOOD5BISCUITS SWSS250
5214FRUTAPPLEIT120
5315VEGETIBLEONIONPO100
5416VEGETIBLEONIONLOC101
5517FOOD6BISCUITS SWBR250
5618FOOD7BISCUITS SWBR251
5719FOOD8BISCUITS SWBR252
SH1
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,624
Insert this line of code:
VBA Code:
Sheets(1).UsedRange.ClearContents
immediately below this line:
Code:
Set WorkbookDestination = ThisWorkbook
 

KalilMe

Board Regular
Joined
Mar 5, 2021
Messages
122
Office Version
  1. 2016
Platform
  1. Windows
brilliant ! many thanks for your codes and times(y)
 

Forum statistics

Threads
1,140,917
Messages
5,703,166
Members
421,279
Latest member
emzy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top