PDA

View Full Version : [SOLVED] vba to loop through multiple worksheets and paste specific data based on a date



spittingfire
05-20-2016, 05:26 PM
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
05-21-2016, 07:13 AM
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
05-21-2016, 08:34 AM
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
05-21-2016, 09:24 AM
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
05-21-2016, 11:14 AM
Thanks mdmackillop. I will give it a go and see what happens. Much appreciated your assistance with this.