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

 

[KalilMe]

the file name is OUTPUT

 

[mumps]

Will that file also contain the macro? What is the file extension (xlsx, xlsm)?

 

[KalilMe]

yes it should XLSM

 

[mumps]

This macro assumes that the destination sheet (Sheet1) exists in the workbook containing the macro.

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

 

[KalilMe]

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]

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]

this is what I got when I run macro continuously

INVE1.xlsx
	A	B	C	D	E
1	ITEM	GOODS	TYPE	PR	QTY
2	1	FRIUT	BANANA	SO	200
3	2	VEGTIBLE	TOMATO	EG	100
4	3	FOOD1	TUNE160G	SP	150
5	4	FOOD2	TUNE180G	TH	250
6	5	FOOD3	CHEESE CHEEDER	NE	300
7	6	FRUT	APPLE	TU	120
8	7	VEGTIBLE	POTATO	GR	100
9	9	FOOD5	BISCUITS SW	SW	150
10	10	FOOD1	TUNE160G	IN	140
11	11	FOOD2	TUNE180G	TW	130
12	12	FOOD3	CHEESE MOZZIRELA	IT	300
13	13	FOOD5	BISCUITS SW	SS	250
14	14	FRUT	APPLE	IT	120
15	15	VEGETIBLE	ONION	PO	100
16	16	VEGETIBLE	ONION	LOC	101
17	17	FOOD6	BISCUITS SW	BR	250
18	18	FOOD7	BISCUITS SW	BR	251
19	19	FOOD8	BISCUITS SW	BR	252
20	ITEM	GOODS	TYPE	PR	QTY
21	1	FRIUT	BANANA	SO	200
22	2	VEGTIBLE	TOMATO	EG	100
23	3	FOOD1	TUNE160G	SP	150
24	4	FOOD2	TUNE180G	TH	250
25	5	FOOD3	CHEESE CHEEDER	NE	300
26	6	FRUT	APPLE	TU	120
27	7	VEGTIBLE	POTATO	GR	100
28	9	FOOD5	BISCUITS SW	SW	150
29	10	FOOD1	TUNE160G	IN	140
30	11	FOOD2	TUNE180G	TW	130
31	12	FOOD3	CHEESE MOZZIRELA	IT	300
32	13	FOOD5	BISCUITS SW	SS	250
33	14	FRUT	APPLE	IT	120
34	15	VEGETIBLE	ONION	PO	100
35	16	VEGETIBLE	ONION	LOC	101
36	17	FOOD6	BISCUITS SW	BR	250
37	18	FOOD7	BISCUITS SW	BR	251
38	19	FOOD8	BISCUITS SW	BR	252
39	ITEM	GOODS	TYPE	PR	QTY
40	1	FRIUT	BANANA	SO	200
41	2	VEGTIBLE	TOMATO	EG	100
42	3	FOOD1	TUNE160G	SP	150
43	4	FOOD2	TUNE180G	TH	250
44	5	FOOD3	CHEESE CHEEDER	NE	300
45	6	FRUT	APPLE	TU	120
46	7	VEGTIBLE	POTATO	GR	100
47	9	FOOD5	BISCUITS SW	SW	150
48	10	FOOD1	TUNE160G	IN	140
49	11	FOOD2	TUNE180G	TW	130
50	12	FOOD3	CHEESE MOZZIRELA	IT	300
51	13	FOOD5	BISCUITS SW	SS	250
52	14	FRUT	APPLE	IT	120
53	15	VEGETIBLE	ONION	PO	100
54	16	VEGETIBLE	ONION	LOC	101
55	17	FOOD6	BISCUITS SW	BR	250
56	18	FOOD7	BISCUITS SW	BR	251
57	19	FOOD8	BISCUITS SW	BR	252
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
	A	B	C	D	E
39	ITEM	GOODS	TYPE	PR	QTY
40	1	FRIUT	BANANA	SO	200
41	2	VEGTIBLE	TOMATO	EG	100
42	3	FOOD1	TUNE160G	SP	150
43	4	FOOD2	TUNE180G	TH	250
44	5	FOOD3	CHEESE CHEEDER	NE	300
45	6	FRUT	APPLE	TU	120
46	7	VEGTIBLE	POTATO	GR	100
47	9	FOOD5	BISCUITS SW	SW	150
48	10	FOOD1	TUNE160G	IN	140
49	11	FOOD2	TUNE180G	TW	130
50	12	FOOD3	CHEESE MOZZIRELA	IT	300
51	13	FOOD5	BISCUITS SW	SS	250
52	14	FRUT	APPLE	IT	120
53	15	VEGETIBLE	ONION	PO	100
54	16	VEGETIBLE	ONION	LOC	101
55	17	FOOD6	BISCUITS SW	BR	250
56	18	FOOD7	BISCUITS SW	BR	251
57	19	FOOD8	BISCUITS SW	BR	252
SH1

 

[mumps]

Insert this line of code:

Sheets(1).UsedRange.ClearContents

immediately below this line:

Set WorkbookDestination = ThisWorkbook

 

[KalilMe]

brilliant ! many thanks for your codes and times

 

[mumps]

You are very welcome.