vba to loop through multiple worksheets and paste specific data based on a date

[spittingfire]

Hi All,

Looking for some help for someone to create a vba code to loop through a sheet and return data. I have attached 2 workbooks - one workbook has the test data and the other workbook is the workbook that I will like to pull the data into.

Book workbooks will be located in different folders for example forecast_test.xlsm is located in C:\test and testdata.xlsb is located in d:\test.

What I'm looking to accomplish is a macro that when run will automatically look at today's date and grab the data from forecast_test.xlsm from 7 days and 1 day ago. Copying data from forecast_test.xlsm "BS8:BX55" to testdata.xlsb "idp - lastweek B2:S49"

So for example if today is 5/20/2016 when I run the macro it will loop through forecast_test.xlsm and stop at sheet 13 (which in this case is 5/13/2016) copy the data from BS8:BX55 and paste it to testdata.xlsb "IDP- last week" into range B2:S49.

The macro will then continue to loop through forecast_test.xlsm and stop at sheet 19 (which in this case is 5/19/2016) copy the data from BS8:BX55 and paste it to testdata.xlsb "IDP- yesterday" into range B2:S49.

Both data I will like to paste as values.

So just to clarify I'm looking for two things today -7 (which is 7 days ago) and today -1 (which is yesterday)

This is beyond my current knowledge of excel vba and looking for help in creating this.

Thanks in advance for any help you can provide.

[mdmackillop]

No need to loop.

Sub Test()


    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim ws As Worksheet
    Dim Dte As Long
    Dim r As Range
    Dim chk As Boolean


    x = Day(Now)


    Set wbTarget = ThisWorkbook
    On Error Resume Next
    Set wbSource = Workbooks("testdata.xlsb")
    If Err Then
        Set wbSource = Workbooks.Open("C:\VBAX\testdata.xlsb")
        chk = True
    End If




    Set ws = wbSource.Sheets(x - 7)
    Set r = ws.Range("BS8").Resize(48, 6)
    wbTarget.Sheets("IDP- last week").Range("B2").Resize(48, 6).Value = r.Value




    Set ws = wbSource.Sheets(x - 1)
    Set r = ws.Range("BS8").Resize(48, 6)
    wbTarget.Sheets("IDP- Yesterday").Range("B2").Resize(48, 6).Value = r.Value


    If chk Then Workbooks("testdata.xlsb").Close False


End Sub

[spittingfire]

No need to loop.

Sub Test()


    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim ws As Worksheet
    Dim Dte As Long
    Dim r As Range
    Dim chk As Boolean


    x = Day(Now)


    Set wbTarget = ThisWorkbook
    On Error Resume Next
    Set wbSource = Workbooks("testdata.xlsb")
    If Err Then
        Set wbSource = Workbooks.Open("C:\VBAX\testdata.xlsb")
        chk = True
    End If




    Set ws = wbSource.Sheets(x - 7)
    Set r = ws.Range("BS8").Resize(48, 6)
    wbTarget.Sheets("IDP- last week").Range("B2").Resize(48, 6).Value = r.Value




    Set ws = wbSource.Sheets(x - 1)
    Set r = ws.Range("BS8").Resize(48, 6)
    wbTarget.Sheets("IDP- Yesterday").Range("B2").Resize(48, 6).Value = r.Value


    If chk Then Workbooks("testdata.xlsb").Close False


End Sub

Thanks mdmackillop for getting back to me. The code that you provided is a work of genius and I appreciate it greatly, but I will need to tweak it a little and hopefully it's not too difficult a change.

The tweak that I will need is the source location. I discovered that the filenames are written in the format of "May 2016 - testdata.xlsb". So for example next month it will be "June 2016 - testdata.xlsb" so instead of fixing a filename as the source name can you just modify the code to pick up the name of the file based on the current month instead? Secondly once the current month is over the file is moved to a subfolder called Archive. Is it possible (and this may be tricky) that for example on the 1st of the month when we are doing the today - 7 it will search the archive subfolder for the previous month file and return the data? So for example on June 1st it will search the archive file and pick up "May 2016 - testdata.xlsb" and return data from the 25th (previous 7 days) and the 31st (previous day). The filenames and location are static except the name of the month and year changes so I think it may be possible. Thanks again in advance for your help

[mdmackillop]

Give this a try

Sub Test()


    Dim wbSource As Workbook
    Dim wbTarget As Workbook
    Dim ws As Worksheet
    Dim Dte As Long, i As Long, x As Long
    Dim r As Range
    Dim chk As Boolean
    Dim FName As String
    Dim Days, Shts


    Days = Array(1, 7)
    Shts = Array("IDP- Yesterday", "IDP- last week")


    Set wbTarget = ThisWorkbook


    For i = 0 To 1
        x = Days(i)


        FName = Format(Date - x, "mmmm") & " " & Year(Date - x) & " - testdata.xlsb"


        On Error Resume Next
        Set wbSource = Workbooks(FName)


        If Err Then
            If Month(Date) = Month(Date - x) Then
                Set wbSource = Workbooks.Open("C:\VBAX\" & FName)
            Else
                Set wbSource = Workbooks.Open("C:\VBAX\Archive\" & FName)
            End If
            chk = True
        End If


        Set ws = wbSource.Sheets(Day(Date - x))
        Set r = ws.Range("BS8").Resize(48, 6)
        wbTarget.Sheets(Shts(i)).Range("B2").Resize(48, 6).Value = r.Value


        If chk Then wbSource.Close False
    Next i
End Sub

[spittingfire]

Thanks mdmackillop. I will give it a go and see what happens. Much appreciated your assistance with this.