VBA to copy data from multiple workbooks into single master xls

[dsauter]

Here is what I am trying to do.

I have a few spreadsheets in a folder (c:\dump\tally). I am trying to grab the data found in A3:AA3 for each of these files in the "Rollup" tab and drop them into the Excel file hosting the macro in the Sheet1 tab. And since the source data is mostly formula based, I am trying to paste the values only. Below is the code I found on this form posted by Mumps, which I've updated -


Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim LastRow As Long
Const strPath As String = "C:\Dump\Tally"
ChDir strPath
strExtension = Dir("*.xlsx*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource
LastRow = .Sheets("Rollup").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Sheets("Rollup").Range("A3:AA3" & LastRow).Copy wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
.Close savechanges:=False
End With
strExtension = Dir
Loop
Application.ScreenUpdating = True
End Sub

I am having 2 issues -

1 - data is being inserted into the same target row for each of the source files resulting in data being overwritten. I'm not very familiar with VBA but I thought it was possibly because my source data is not populating the A column when copied (by design) and because of this code "(Rows.Count, "A")" it was always seeing the row i just wrote as blank upon loop so I changed the A to B but it didn't seem to help.

2 - I am trying to get the values to paste in since the source is largely using formulas. I attempted to put the PasteSpecial Paste:=xlPasteValues parameter into the macro but I must be screwing something up there as well since I am getting errors no matter where I drop this.

Any suggestions?

 

[Trebor76]

Hi dsauter,

Welcome to MrExcel!!

Though largely untested this should do the job:

Option Explicit
Sub CopyRange()
    
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Dim strPath As String
    Dim varFileName As Variant
    Dim lngPasteRow As Long
        
    Application.ScreenUpdating = False
    
    Set wkbDest = ThisWorkbook
    
    strPath = "C:\Dump\Tally"
    If Right(strPath, 1) <> "" Then
        strPath = strPath & ""
    End If
    
    varFileName = Dir(strPath & "*.xls*")
    Do While Len(varFileName) > 0
        Set wkbSource = Workbooks.Open(strPath & varFileName)
        wkbSource.Sheets("Rollup").Range("A3:AA3").Copy
        With wkbDest.Sheets("Sheet1")
            lngPasteRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & lngPasteRow).PasteSpecial xlPasteValues
        End With
        varFileName = Dir
    Loop
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[dsauter]

Thanks Robert! Really appreciate it!

This was just about perfect. Just had to add a backslash to strPath and change the rows.count parameter to B to check for the last row based on my setup. Pasted the update below for anyone reading this.

One more question if I may.

I am trying to close down the spreadsheets that the macro is opening after the contents are streamed into my master sheet. I added "wkbSource.Close Savechanges = False" to where I think is the right spot but I am compile error stating the variable isn't defined although I used your existing declaration. What am I doing wrong?


Sub CopyRange()

Dim wkbDest As Workbook
Dim wkbSource As Workbook
Dim strPath As String
Dim varFileName As Variant
Dim lngPasteRow As Long

Application.ScreenUpdating = False

Set wkbDest = ThisWorkbook

strPath = "C:\Dump\Tally"
If Right(strPath, 1) <> "" Then
strPath = strPath & ""
End If

varFileName = Dir(strPath & "*.xlsx*")
Do While Len(varFileName) > 0
Set wkbSource = Workbooks.Open(strPath & varFileName)
wkbSource.Sheets("Rollup").Range("A3:AA3").Copy
With wkbDest.Sheets("Sheet1")
lngPasteRow = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Range("A" & lngPasteRow).PasteSpecial xlPasteValues
wkbSource.Close Savechanges = False
End With
varFileName = Dir

Loop

Application.ScreenUpdating = True


End Sub

 

[Trebor76]

I think this line...

wkbSource.Close Savechanges = False

...should be this:

wkbSource.Close SaveChanges:= False

I don't understand why you've put the asterisk wildcard like this...

varFileName = Dir(strPath & "*.xlsx*")

...as to pick up all Excel file types from the directory I would have though it should be this:

varFileName = Dir(strPath & "*.xls*")

I don't really understand this either...

If Right(strPath, 1) <> "" Then

...but if works then OK

Regards,

Robert

 

[dsauter]

Thanks Robert. That worked! I really appreciate you help!