Thread: How to copy data from one workbook to another

Originally Posted by royUK

Here's some code that you can adapt for your needs

Option Explicit
'---------------------------------------------------------------------------------------
' Module    : Data
' Author    : Roy Cox (royUK)
' Website   : for more examples and Excel Consulting
' Date      : 19/11/2011
' Purpose   : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.
 
'---------------------------------------------------------------------------------------

Option Explicit

Sub CombineData()
    Dim oWbk As Workbook
    Dim uRng As Range
    Dim rToCopy As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean
    Dim sFil As String
    Dim sPath As String

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        '   On Error GoTo exithandler
        sPath = ThisWorkbook.Path & Application.PathSeparator & "Data"
        ChDir sPath
        sFil = Dir("*.xls")    'change or add formats
        Do While sFil <> ""    'will start LOOP until all files in folder sPath have been looped through

            With ThisWorkbook.Worksheets(1)
                Set uRng = .UsedRange
                If uRng.Cells.Count = 0 Then
                    'no data in master sheet
                    bHeaders = False
                Else: bHeaders = True
                End If

                Set oWbk = Workbooks.Open(sPath & Application.PathSeparator & sFil)    'opens the file
                Set rToCopy = oWbk.ActiveSheet.UsedRange
                If Not bHeaders Then
                    Set rNextCl = .Cells(1, 1)
                    bHeaders = True
                Else: Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    'headers exist so don't copy
                    Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                              rToCopy.Columns.Count)
                End If
                rToCopy.Copy rNextCl
            End With
            oWbk.Close False     'close source workbook
            sFil = Dir
        Loop    ' End of LOOP
        'sort to remove empty rows
        Set uRng = ThisWorkbook.Worksheets(1).UsedRange
        uRng.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
exithandler:
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

Thanks for that. Unfotunately I'm a novice when it comes to script like this and wouldn't know where to start to adapt this to my needs?

Being new to forums and unsure of what is expected. You posted a message telling me the title was worng and did not comply. I changed the title and understood it that the original post was stopped and therefore re-posted it with a new heading. I am certainly not out to "waste time" and appreciate any help I can get.

Hi

I have been playing around with the sample code that you posted. But seem to be stuck. When I run it I get "Path Not Found" I think what I understand is that "sPath" set the directory to the directory my excel file is in? But even if I manual enter the directory after chDir (Instead of sPath) I still get the same result? Is there something I'm not doing?

Thanks

Mark

P.S How do I stop one of the threads seeing as there is now two?

Sorry forget the last bit. I noticed "& Data" that was being added to the path so I took it out. Still trying to work the rest out as seems to run with no errors but nothing copies over.

Hi again

Got it working! Thank you. I took my sheet home from work home p.c uses excel 2010 as work p.c uses 2003 that wouldn`t make a difference would it? Only thing is it copies every sheet from every workbook I would like it to copy only one sheet from each called "Work Totals" is that possible? Thanks for your help so far ive been racking my brain with this for weeks.

Managed to get it sorted to take data from sheet 22 of the workbooks and it was working but now I am getting a runtime error 1004 "set method of range class failed" Any idea what the problem could be?

Thanks

Mark