PDA

View Full Version : Help with a VBA macro - merge multiple workbooks in one workbook with source names



jchula
08-05-2013, 09:58 AM
Hi,

I want to combine multiple workbooks (sheet1 in every workbook) in one destination workbook.
The destination workbook must have the multiple worksheets with the name of source workbook.
Example:

File Store1.xlsx with sheet1; Store2.xlsx with sheet1; Store3.xlsx with sheet1;...

I want a destination workbook ALLSTORES.xlsx with worksheets Store1; Store2; Store3;...

i have this code but this dont give me the names of the stores; give me sheet1, sheet2, sheet3,....

Thks



Public Sub test()


Dim myFile As String, sh As Worksheet, myRange As Range
Const myPath = "C:\Users\" ' to be modified
Workbooks.Add 1 ' Add a new workbook
myFile = Dir(myPath & "*.xlsx")

Do While myFile <> ""
Set sh = ActiveWorkbook.Sheets.Add()

Workbooks.Open myPath & myFile
Cells.Copy Destination:=sh.Range("A1")
' Set myRange = ActiveSheet.UsedRange
' Set myRange = myRange.Offset(1).Resize(myRange.Rows.Count - 1)
' myRange.Copy sh.Range("A65000").End(xlUp).Offset(1)
ActiveSheet.Name = myFile
Workbooks(myFile).Close False
myFile = Dir
Loop
End Sub

patel
08-05-2013, 11:43 AM
Merge data from all workbooks in a folder (1) (http://www.rondebruin.nl/win/s3/win008.htm)

jchula
08-06-2013, 11:07 AM
[QUOTE=jchula;294634]Hi,

I want to combine multiple workbooks (sheet1 in every workbook) in one destination workbook.
The destination workbook must have the multiple worksheets with the name of source workbook.
Example:

File Store1.xlsx with sheet1; Store2.xlsx with sheet1; Store3.xlsx with sheet1;...

I want a destination workbook ALLSTORES.xlsx with worksheets Store1; Store2; Store3;...

i have this code but this dont give me the names of the stores; give me sheet1, sheet2, sheet3,....

Thks



Thanks for your help.
The code gives me a error, i think that was the file name extension, maybe to big...
I īve made a few modifications. I put the source worksheet name in the destination workbook and it works!







Public Test_()
Dim myFile As String, sh As Worksheet, myRange As Range
Dim myPath As String

myPath = InputBox("input the xlsx files path with a \ in the end ")

myFile = Dir(myPath & "*.xlsx")

Dim sh_name As String

Do While myFile <> ""
Set sh = ActiveWorkbook.Sheets.Add()
Workbooks.Open myPath & myFile

sh_name = Workbooks(myFile).ActiveSheet.Name

Cells.Copy destination:=sh.Range("A1")

sh.Name = sh_name

Workbooks(myFile).Close False
myFile = Dir
Loop
End Sub