Combine mutiple xlsx into one master sheet

[JJremie]

Need to combine multiple xls from a specific location. All xlsx's are the same format meaning all have the exact columns headings for A-N. Would like to combine each sheet into a new workbook with 1 master sheet of the data. 1st row should have the common colun headings and all the data combined in the rows below without breaks or blanks.

Also if possible take the file name and input that into column N for each entry(preferably without the file extension.
I currently have a VBA code that allows me to make one workbook with multiple sheets ,but not a master book with 1 master sheet.
You can work with my current code(request it) or provide new vba code. Any help would be appreciated

[Keebellah]

Hi, welcome to the forum,
We do not request, is you have code and a sample you provide it along with an explanation clear enough for others to understand, so... if you want us to help, what's holding you back?
Make sure the file doe not contain private or sensitive data.
I will gladly take a look at it and see if I can help you with it, as I am sure others here on the forum too.

[JJremie]

Copy of the current code


'The following code will combine all data into one excel workbook.
Sub CombineFiles_Step1()
'Declare Variables
Dim WorkbookDestination As Workbook
Dim WorkbookSource As Workbook
Dim WorksheetSource As Worksheet
Dim FolderLocation As String
Dim strFilename As String

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)

'Iterate for each file in folder
If Len(strFilename) = 0 Then Exit Sub


Do Until strFilename = ""

Set WorkbookSource = Workbooks.Open(Filename:=FolderLocation & "\" & strFilename)
Set WorksheetSource = WorkbookSource.Worksheets(1)
WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
WorkbookSource.Close False
strFilename = Dir()

Loop
WorkbookDestination.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub


would like to implement something like the following:

With .Worksheets("CalOptima Sept Template")
numrows = .Cells(.Rows.Count, "A").End(xlUp).Row
If nextrow = 1 Then
.Rows(1).Resize(numrows).Copy wbTarget.Worksheets(1).Cells(nextrow, "A")
Else
.Rows(2).Resize(numrows - 1).Copy wbTarget.Worksheets(1).Cells(nextrow, "A")
End If
nextrow = nextrow + numrows
End With

[Keebellah]

Well this a way too. I'll check and let you know.

You should use the correct code to post macro contents

[ code ]



[ / code ]

without the spaces

Please Login or Register  to view this content.

[JJremie]

Reposting the code

Please Login or Register  to view this content.

would like to implement something like the following:

Please Login or Register  to view this content.

[JJremie]

The following code is slightly working however it's not merging all active sheets

Any Ideas?

Please Login or Register  to view this content.