Copy data from closed workbooks

I need to copy data from 18 different workbooks. Each workbook will be in the same folder. Each workbook will have a different name but there will only be these 18 files in the folder although more could be added in the future but the same rules will apply.  Each workbook will have over 20 sheets and I need to copy data from 14 of them, daily.

So my question is, Can an expert provide me with vba code that will:

Copy data from each file and insert the data inot my active workbook without opening the 18 closed workbooks

The range is the same in all 14 sheets in every one of the workbooks. [A7:S?] (so if the are 3 tems A7;S9, 50 items A7:S56 etc)

in my active workbook the range is the same, so the data would be copied into [Say Sheet1] cell A7. Data from each of the other 17 workbooks would be added to the next blank cell in column A each time.

so Copy A7:S9 from first workbook into Active workbook cell A7 [3 items]  then  Copy A7:S56 from second workbook into Active workbook cell A10 [50 items]

Thanksin advance
JagwarmanAsked:
Who is Participating?
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.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Please try the following code and see if it does what you are trying to achieve.

Preparation:

1) Reference Required: Microsoft Scripting Runtime

2) Make sure to change the Source Folder Path in the code as per requirement.

Sub CopyDataFromWorkbooks()
Dim Swb As Workbook, Dwb As Workbook
Dim ws As Worksheet, Dws As Worksheet
Dim fso As Scripting.FileSystemObject
Dim fil As Scripting.File
Dim sFolderPath As String
Dim SourceFolder As Scripting.Folder
Dim Dlr As Long, Slr As Long, cnt As Long

Application.ScreenUpdating = False

sFolderPath = "C:\Jagwarman\My Files"   'Source Folder Path
Set Dwb = ThisWorkbook
Set Dws = Dwb.Sheets("Sheet1")             'Destination Sheet on the Master Workbook where data will be copied

Dlr = Dws.Cells(Rows.Count, 1).End(xlUp).Row
If Dlr > 6 Then Dws.Range("A7:S" & Dlr).Clear

Set fso = New Scripting.FileSystemObject

If Not fso.FolderExists(sFolderPath) Then
    MsgBox "Source Folder does not exists."
    Exit Sub
End If

Set SourceFolder = fso.GetFolder(sFolderPath)

For Each fil In SourceFolder.Files
    DoEvents
    If Left(fso.GetExtensionName(fil.Path), 2) = "xl" And fil.Name <> Dwb.Name Then
        Application.StatusBar = "Processing file " & fil.Name & " of folder " & sFolderPath & "."
        Workbooks.Open fil.Path
        Set Swb = ActiveWorkbook
        For Each ws In Swb.Worksheets
            Slr = ws.Cells(Rows.Count, 1).End(xlUp).Row
            cnt = cnt + 1
            If Slr > 6 And cnt <= 14 Then
                Dlr = Dws.Cells(Rows.Count, 1).End(xlUp).Row + 1
                If Dlr <= 6 Then Dlr = 7
                ws.Range("A7:S" & Slr).Copy Dws.Range("A" & Dlr)
                Application.CutCopyMode = 0
            End If
        Next ws
    End If
    cnt = 0
    Swb.Close False
Next fil
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Task Complete.", vbInformation
End Sub

Open in new window

0
JagwarmanAuthor Commented:
I am getting 'User Defined type not defined' at Dim fso As Scripting.FileSystemObject

I added "Microsoft DAO 3.0 Object Library" but still get the error
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You didn't read my reply carefully, its written in the bold that you need to add the reference to the Microsoft Scripting Runtime.
0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

JagwarmanAuthor Commented:
I did read it but do not understand as I am not a VBA expert
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
To add the reference to the Microsoft Scripting Runtime Library, follow these steps....

Press Alt + F11 to open VBA Editor --> Tools --> References --> Find Microsoft Scripting Runtime from the list below --> Check the box next to Microsoft Scripting Runtime --> OK

That's it.

Let me know if you are still having any issue with this.
0
JagwarmanAuthor Commented:
sorry for being dumb.

Now I get

Swb.Close False

Object variable or with block Variable not set
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Replace the previous code with the following code and see if this works without an error.

Sub CopyDataFromWorkbooks()
Dim Swb As Workbook, Dwb As Workbook
Dim ws As Worksheet, Dws As Worksheet
Dim fso As Scripting.FileSystemObject
Dim fil As Scripting.File
Dim sFolderPath As String
Dim SourceFolder As Scripting.Folder
Dim Dlr As Long, Slr As Long, cnt As Long

Application.ScreenUpdating = False

sFolderPath = "C:\Jagwarman\My Files"   'Source Folder Path
Set Dwb = ThisWorkbook
Set Dws = Dwb.Sheets("Sheet1")             'Destination Sheet on the Master Workbook where data will be copied

Dlr = Dws.Cells(Rows.Count, 1).End(xlUp).Row
If Dlr > 6 Then Dws.Range("A7:S" & Dlr).Clear

Set fso = New Scripting.FileSystemObject

If Not fso.FolderExists(sFolderPath) Then
    MsgBox "Source Folder does not exists."
    Exit Sub
End If

Set SourceFolder = fso.GetFolder(sFolderPath)

For Each fil In SourceFolder.Files
    DoEvents
    If Left(fso.GetExtensionName(fil.Path), 2) = "xl" And fil.Name <> Dwb.Name And Left(fil.Name, 1) <> "~" Then
        Application.StatusBar = "Processing file " & fil.Name & " of folder " & sFolderPath & "."
        Workbooks.Open fil.Path
        Set Swb = ActiveWorkbook
        For Each ws In Swb.Worksheets
            Slr = ws.Cells(Rows.Count, 1).End(xlUp).Row
            cnt = cnt + 1
            If Slr > 6 And cnt <= 14 Then
                Dlr = Dws.Cells(Rows.Count, 1).End(xlUp).Row + 1
                If Dlr <= 6 Then Dlr = 7
                ws.Range("A7:S" & Slr).Copy Dws.Range("A" & Dlr)
                Application.CutCopyMode = 0
            End If
        Next ws
        Swb.Close False
    End If
    cnt = 0
Next fil
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Task Complete.", vbInformation
End Sub

Open in new window

0

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
JagwarmanAuthor Commented:
Hi sktneer

I need to give it a good test but in the meantime, I note it is copying with all the existing formulas, is it possible to change this so that it 'pastes Values only'

Thanks for your help with this.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
To paste the values only, change this line of code

ws.Range("A7:S" & Slr).Copy Dws.Range("A" & Dlr)

Open in new window


With this line of code.

ws.Range("A7:S" & Slr).Copy
Dws.Range("A" & Dlr).PasteSpecial xlPasteValues

Open in new window

0
JagwarmanAuthor Commented:
sktneer, sorry forgot I had some days off coming up. Back now so will be back on the testing today.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Sure...
0
JagwarmanAuthor Commented:
sktneer,

I have performed all sorts of tests on this to make sure it does what I need and unless I have missed any..........This is brilliant. It does exactly what I need it to. You are one 'Super Expert' Many thanks.
0
JagwarmanAuthor Commented:
If I could give more than 500 points I would.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Jagwarman! Glad I could help.
And thanks for your kind words. Very much appreciated. :)
0
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
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.