You created this for me a while ago
I extended the column range in my Target WB
and modified the following line
For c2 = 7 To 58 ' G to BF
Just wondering if I should be aware of something else?
Code: Select all
Sub ScheduleData()
Dim wbkS As Workbook ' Source workbook
Dim wbkT As Workbook ' Target workbook
Dim wshS As Worksheet ' Source sheet
Dim wshT As Worksheet ' Target sheet
Dim strSheet As String
Dim rngFound As Range
Dim r As Long
Dim c As Long
Dim m As Long
Dim c2 As Long
Dim strFormula As String
Dim strType As String
Application.ScreenUpdating = False
' Source workbook - modify the path as needed
Set wbkS = Workbooks.Open(Filename:="H:\2014 SSR\Test R18\150119 SSR Macro\DataVolume.xls")
' Target workbook
Set wbkT = ThisWorkbook
' Loop through the sheets
For Each wshT In wbkT.Worksheets
Select Case wshT.Name
Case "BidDashboard", "HoursBackDashboard", "ASRDashboard", "SPTO", "Hours", "Attrition", "Actuals", "Data", "Data2", "Data3", "Data4"
' Skip these sheets
Case Else
For r = 35 To 49
strSheet = wshT.Cells(r, 1).Value
strSheet = Left(strSheet, InStr(strSheet, "_") - 1)
strType = wshT.Cells(r, 3).Value
Set wshS = wbkS.Worksheets(strSheet)
m = wshS.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set rngFound = wshS.Range("1:1").Find(What:=strType, LookAt:=xlWhole, MatchCase:=False)
c = rngFound.Column
strFormula = "=SUMIFS([DataVolume.xls]@0!R2C@1:R@2C@1," & _
"[DataVolume.xls]@0!R2C2:R@2C2,R31C," & _
"[DataVolume.xls]@0!R2C1:R@2C1,R32C," & _
"[DataVolume.xls]@0!R2C3:R@2C3,R1C4," & _
"[DataVolume.xls]@0!R2C4:R@2C4,RC2)"
strFormula = Replace(strFormula, "@0", strSheet)
strFormula = Replace(strFormula, "@1", c)
strFormula = Replace(strFormula, "@2", m)
For c2 = 7 To 58 ' G to BF
With wshT.Cells(r, c2)
If .Value = "" Then
.FormulaR1C1 = strFormula
.Value = .Value
End If
End With
Next c2
Next r
End Select
Next wshT
wbkS.Close SaveChanges:=False
Application.ScreenUpdating = True
MsgBox "Data copied!", vbInformation
End Sub