copy worksheets to specific workbook using VBA

Dear Experts:

I would like to copy a specific worksheet from different excel files to one and the same worksheet (named Overall_List) of a workbook named 'Aggregate_File.xlsx'.

Here are the details for the macro:

6 Excel-files reside in a folder with the following path: C:\MyDocuments\MyFiles\...

5 of these excel workbooks have a worksheet named 'Prod_List' which need to be copied to the  worksheet named 'Overall_List' of the file named 'Aggregate_File.xlsx'

The macro should only copy the current range starting from A2 of these worksheets named 'ProdList'. The copied contents of these worksheets (Prod_List) is to be inserted one after the other to this worksheet 'Overall_List' of the 'Aggregate_File.xlsx.

Any contents in this worksheet 'Overall_List' is to be deleted, i.e. the copied contents overwrites any existing contents.

The formatting of the copied cells is to be retained.

Help is very much appreciated. Thank you very much in advance.

Regards, Andreas

copy worksheets
Andreas HermleTeam leaderAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
Andreas

Try this, which assumes there is a header row on each 'Prod_List' sheet and on 'Overall_List'.
Sub AggregrateProdList()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim rngDst As Range
Dim rngSrc As Range
Dim strPath As String
Dim strFileName As String

    strPath = "C:\MyDocuments\MyFiles\"
    
    Set wbDst = Workbooks("Aggregate_File.xlsx")
    
    Set wsDst = wbDst.Sheets("Overall_List")
    
    wsDst.Range("A2").CurrentRegion.Offset(1).Delete
    
    Set rngDst = wsDst.Range("A2")
    
    strFileName = Dir(strPath & "*.xlsx")
    
    Do
    
        Set wbSrc = Workbooks.Open(strPath & strFileName)
        
        Set wsSrc = wbSrc.Sheets("Prod_List")
        
        Set rngSrc = wsSrc.Range("A2").CurrentRegion.Offset(1)
        
        rngSrc.Copy rngDst
        
        Set rngDst = wsDst.Range("A" & Rows.Count).End(xlUp).Offset(1)
        
        wbSrc.Close SaveChanges:=False
        
        strFileName = Dir
        
    Loop Until Len(strFileName) = 0
    
End Sub

Open in new window

Andreas HermleTeam leaderAuthor Commented:
Hi Norie,

thank you very much for your swift and professional help. Works good although I would like you to tweak it a little bit since two errors need to be trapped.

Firstly: If the Aggregate_File.xlsx has not been opened prior to the running of the macro, the following error pops up.

Index out of valid range: runtime error 9: line 13

Hence the macro should check whether the file 'C:\MyDocuments\MyFiles\Aggregate_File.xlsx' is currently open (I noticed that the 'Aggregate_File.xlsx' does not have to be the active workbook for the macro to run properly)  and if the aforementioned file has not been opened, the macro is to exit and tell the user to open this file first.

Secondly: All the desired contents is nicely copied :-) into the 'Overall_List' worksheet, but then the macro tries to open the (already open) 'Aggregate_File.xlsx' and then the following error message pops up:

Aggregate_File.xlsx is already open. If you re-open it, you will lose all the changes you have made. Do you want to open'Aggregate_File.xlsx' again?

Hence I think the already open 'Aggregate_File.xlsx' has to be excluded from the 'do ... loop' part of your code. Am I getting this right?

Again, thank you very much for your great help, I really appreciate it.

Regards, Andreas
NorieAnalyst Assistant Commented:
Andreas

Most of those things I meant to address but didn't have the time this morning.

Should really have added in a few more comments and notes on assumptions too.

As for the aggregate file not being opened, is it always in the same folder as the other files?
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Andreas HermleTeam leaderAuthor Commented:
HI Norie,

never mind ...  :-)

Yes, the aggregate file is always in the same folder as the other files. There is no exception to this fact.

Thank you very much.

Regards, Andreas
NorieAnalyst Assistant Commented:
Andreas

Here's the code updated to handle the raised issues and with comments added.
Option Explicit

Sub AggregateProdList()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim rngDst As Range
Dim rngSrc As Range
Dim strPath As String
Dim strFileName As String
Dim strAggFileName As String

    strPath = "C:\MyDocuments\MyFiles\"

    strAggFileName = "Aggregate_File.xlsx"

    ' if aggregate workbook is already open set a reference to it
    On Error Resume Next
    Set wbDst = Workbooks(strAggFileName)
    On Error GoTo 0


    ' if aggregate workbook isn't open then open it and set a reference to it.
    If wbDst Is Nothing Then
        Set wbDst = Workbooks.Open(strPath & strAggFileName)
    End If

    ' set reference to destination sheet
    Set wsDst = wbDst.Sheets("Overall_List")

    ' clear data from destination sheet
    wsDst.Range("A2").CurrentRegion.Offset(1).Delete

    ' set initial location to copy data to
    Set rngDst = wsDst.Range("A2")

    ' find the first xlsx file in the specified directory
    strFileName = Dir(strPath & "*.xlsx")

    Do

        ' check file isn't the aggregate file
        If strFileName <> strAggFileName Then

            ' open source file and set reference to it
            Set wbSrc = Workbooks.Open(strPath & strFileName)

            ' set reference to appropriate worksheet in source file
            Set wsSrc = wbSrc.Sheets("Prod_List")

            ' set reference to range to be copied from source worksheet
            Set rngSrc = wsSrc.Range("A2").CurrentRegion.Offset(1)

            ' copy data from source worksheet to destination worksheet
            rngSrc.Copy rngDst

            ' update the range to copy to on the destination sheet
            Set rngDst = wsDst.Range("A" & Rows.Count).End(xlUp).Offset(1)

            ' close the source file
            wbSrc.Close SaveChanges:=False
        End If

        ' get the next xlsx file in the specified directory
        strFileName = Dir

    Loop Until Len(strFileName) = 0

End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Andreas HermleTeam leaderAuthor Commented:
Sorry for the delay in giving you a feedback. Will do some testing now and then let you know.

Again thank you very much for your valuable help.

Regards, Andreas
Andreas HermleTeam leaderAuthor Commented:
Wow, Norie, I am deeply impressed by your expertise.

Thank you very much for all these nice comments.

Works like a charm and it is superfast. :-)

Thank you very much for it.
Andreas HermleTeam leaderAuthor Commented:
Great job :-)

Thank you very much for it.

Regards, Andreas
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.