Automating VB Script, copy range of data from multiple workbooks into one workbook

[ratsmdj]

Hello All,

I have been after this project for quite some time and I feel that someone on here with the correct knowledge will be able to assist me. My googlefu is not good enough for VBA projects I guess. I know this will be long winded but please bear with me. I am looking to make a VBA macro script that will download data across multiple books and import them into a master book. From there I can just cut and paste the relevant data to another master book (would be nice to just import it directly to the last book but I know that is asking for a lot so I am ok with just going to the first master and ill just hand copy to the 2^nd master)

The work books are sent every week, there is one folder lets call it USA and then from there, there are 50 states so 50 subfolders within the USA folder.

USA/AL
USA/AK
USA/AR

So on and so forth, in each sub folder there are years, 2016-2019 (where all the old sheets I’ve already downloaded and inputted into the master sheet goes, we can ignore these). The rest of the subfolders are basically monthly reports so for lets say April there will be a total of 4 subfolders named by their state-code-date (example: AL065-00704032019) each week the number AL065 will jump up one these are all downloaded auto magically. So for April my subfolder for USA/AL will look like so:

USA/AL/2016 (ignore)
USA/AL/2017 (ignore)
USA/AL/2018 (ignore)
USA/AL/2019 (ignore)
USA/AL/AL065-00704032019
USA/AL/AL066-00704132019
USA/AL/AL067-00704232019
USA/AL/AL068-00704302019

In each folder it consists of 3 files, 1 .xls (ignore) 1 .xlsx (the data I want is from this sheet) and 1 .pdf that confirms the data on .xlsx is true and correct

So USA/AL/AL065-00704032019 will have the following in its folder:

AL0065-00704032019-PLSC.xls
AL0065-00704032019-PLCRR.XLSX
AL0065-00704032019-PLCR.PDF

After looking at the structure of the folders and deducing what I needed, I will need the VBA script to do the following. I don’t care if I have to run the macro once in every state subdirectory at least I wont have to open files and cut/paste into the master sheet. But in short I need the functions:
Access the

USA directory

Scan through and ignore all the years sub folders. Open only the newest directory:

USA/AL/AL065-00704032019
USA/AL/AL066-00704132019
USA/AL/AL067-00704232019
USA/AL/AL068-00704302019

So in this case the folder would be USA/AL/AL068-007040302019 (4/30/2019 will be the last date modified shown in the operating system file explorer window)

Scan through the folder and open the one .xlsx file and copy sheet: “Monthly” cell range: C6:F11

Ignoring any blank cells or anything that starts with “Enter Voyage Number”

​

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]

_{^{<strike>
</strike>}}[/FONT]
So the VBA script will open up and copy cells C6-G7 respectively and any entry after labeled “Enter Voyage Number” will be excluded.

This will then put data into a master sheet that I can just open up and all values from all 50 folders will already be in one sheet for me to copy into a another sheet.

I have banged by head doing this multiple ways and it does not work, some scripts ive modified doesn’t work, or some will require me ot manually select the file myself.

Thank you please let me know if you have any questions

 

[ratsmdj]

Re: Help with automating VB Script, copy range of data from multiple workbooks into one workbook

I am using a modified version of this:

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:\usa\AL"
ChDir strPath
strExtension = Dir("*.xls*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource
LastRow = .Sheets("Monthly").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Sheets("Monthly").Range("C6:F" & 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 now getting we cannot do that to a merged cell runtime error 1004 @

.Sheets("Monthly").Range("C6:F" & LastRow).Copy wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

 

[ratsmdj]

Re: Help with automating VB Script, copy range of data from multiple workbooks into one workbook

Dang no help here?

I got it working with this:

Sub CopyRange()    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\Tuan-PC\Dropbox\Think Tank\reporting ALL\HAL_PCL\HAL\HAL Lotto Reports\Amsterdam - AM\"
    ChDir strPath
    strExtension = Dir("*.xlsx*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("Monthly").Range("C6:F11").Copy wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub

Only issue is that it is not pasting as values. Any ideas?

 

[ratsmdj]

Re: Help with automating VB Script, copy range of data from multiple workbooks into one workbook

Dang no help here?

I got it working with this:

Sub CopyRange()    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\Tuan-PC\Dropbox\Think Tank\reporting ALL\HAL_PCL\HAL\HAL Lotto Reports\Amsterdam - AM\"
    ChDir strPath
    strExtension = Dir("*.xlsx*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("Monthly").Range("C6:F11").Copy wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub

Only issue is that it is not pasting as values. Any ideas?

77 Views and .. I know someone knows the answer!

 

[Fluff]

Re: Help with automating VB Script, copy range of data from multiple workbooks into one workbook

To get values use

.Sheets("Monthly").Range("C6:F11").Copy 
wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset([COLOR=#ff0000]0[/COLOR], 0).PasteSpecial xlPasteValues

You may also need to change the red 0 to a 1

 

[ratsmdj]

Re: Help with automating VB Script, copy range of data from multiple workbooks into one workbook

To get values use

.Sheets("Monthly").Range("C6:F11").Copy 
wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset([COLOR=#ff0000]0[/COLOR], 0).PasteSpecial xlPasteValues

You may also need to change the red 0 to a 1

I am still new to this and I see that changing the offset just pushes the row down 1 is there a reason why they all start with 1? Thank you for helping me

 

[ratsmdj]

Re: Help with automating VB Script, copy range of data from multiple workbooks into one workbook

To get values use

.Sheets("Monthly").Range("C6:F11").Copy 
wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset([COLOR=#ff0000]0[/COLOR], 0).PasteSpecial xlPasteValues

You may also need to change the red 0 to a 1

Pasted and changed to a 1 i get this error: Run time error 1004 PasteSpecial method of range class failed

 

[Fluff]

Re: Help with automating VB Script, copy range of data from multiple workbooks into one workbook

Do you have any merged cells?
Is the destination sheet protected?

 

[ratsmdj]

Nevermind rechecked it again and now it works.

One question though the data in the range: C6-F11 sometimes wont have data.

So lets say if its been a long month youll have

C6-F6
C7-F7
C8-F8

Showing data but the rest are blank/empty how can i set the script to ignore it? Some months might have all the rows filled while other months they may just have 1 or 2 rows of data?

 

[Fluff]

Shouldn't make any difference.