Macro to copy sheets from multiple workbooks

[petes]

Hi Friends!!

I have one Master file (MAIN.xlsx) and other files (A.xslx, B.xslx, C.xslx........). All these files are in the same folder (C:\test)

I need a macro in MAIN.xlsx file, so that it should copy all the data only from sheet1 of other files (A.xslx, B.xslx, C.xslx........) and paste it after the sheet1 of MAIN.xlsx file along with their sheet names.

Also, the other files (A.xslx, B.xslx, C.xslx........) should be closed after this operation.

Your help is very much appreciated...!!

 

[VoG]

This might help http://msdn.microsoft.com/en-us/library/cc837974.aspx

 

[petes]

I went through the link that you have provided (very useful) , but this will merge the entire data from (A.xslx, B.xslx, C.xslx........) into one single sheet along with filename.

But actually i need the sheet1 of following files (A.xslx, B.xslx, C.xslx........) to be pasted separately (side by side) in Main.xlsx file along with their sheetnames.

Any thoughts..??

 

[VoG]

Try this

Sub ImportFiles()
Dim MyFolder As String
Dim MyFile As String
Dim wb As Workbook
With ThisWorkbook
    MyFolder = .Path
    MyFile = Dir(MyFolder & "\*.xls")
    Do While MyFile <> ""
        If MyFile <> .Name Then
            .Sheets.Add(after:=.Sheets.Count).Name = Left(MyFile, Len(MyFile) - 4)
            Set wb = Workbooks.Open(MyFolder & "\" & MyFile)
            wb.Sheets(1).UsedRange.Copy Destination:=.Sheets(.Sheets.Count).Range("A1")
            wb.Close False
        End If
        MyFile = Dir
    Loop
End With
End Sub

 

[petes]

I am getting Runtime error 1004 in this line

.Sheets.Add(after:=.Sheets.Count).Name = Left(MyFile, Len(MyFile) - 4)

Whether i need to mention source somewhere..??

 

[VoG]

Sorry, a silly error. Tested and working

Sub ImportFiles()
Dim MyFolder As String
Dim MyFile As String
Dim wb As Workbook
With ThisWorkbook
    MyFolder = .Path
    MyFile = Dir(MyFolder & "\*.xlsx")
    Do While MyFile <> ""
        If MyFile <> .Name Then
            .Sheets.Add(after:=.Sheets(.Sheets.Count)).Name = Left(MyFile, Len(MyFile) - 5)
            Set wb = Workbooks.Open(MyFolder & "\" & MyFile)
            wb.Sheets(1).UsedRange.Copy Destination:=.Sheets(.Sheets.Count).Range("A1")
            wb.Close False
        End If
        MyFile = Dir
    Loop
End With
End Sub

 

[petes]

Wow!! you are genius... you always help me... I am getting inspired by you towards VBA

Thanks!!

 

[mansoormanzoor]

Hi,

I have a similar problem,only that i need to copy cells from different sheets in a same workbook and paste in a summary sheet.

Could you please help?

Mansoor

 

[VoG]

Hi,

I have a similar problem,only that i need to copy cells from different sheets in a same workbook and paste in a summary sheet.

Could you please help?

Mansoor

Try this http://msdn.microsoft.com/en-us/library/cc793964.aspx

 

[petes]

Hi Vog.. I need this code to be altered little bit.

Question: If I run this Macro for the second time (or any number of times) it should not throw any error and should get updated correctly... Rightnow it is displaying "Runtime error 1004" if i run it for the second time as i believe this could be due to the sheet name that is already existing during first run..

Sub ImportFiles()
Dim MyFolder As String
Dim MyFile As String
Dim wb As Workbook
With ThisWorkbook
MyFolder = .Path
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
If MyFile <> .Name Then
.Sheets.Add(after:=.Sheets(.Sheets.Count)).Name = Left(MyFile, Len(MyFile) - 5)
Set wb = Workbooks.Open(MyFolder & "\" & MyFile)
wb.Sheets(1).UsedRange.Copy Destination:=.Sheets(.Sheets.Count).Range("A1")
wb.Close False
End If
MyFile = Dir
Loop
End With
End Sub