Copy data to another spreadsheet based off value stored in string - excel

Question

I have the below code for one of my financial reports and I'm struggling with updating the code to make it more automated. The code creates a string of the column headers stored in multiple sheets. Each column header is a new tab in wb2. I can't figure out how to get formulas copied into a new address range. it needs to copy the values to that Sheet in wb2 and then move on to the next.
So the code needs to:
1/put the column headers to a string/array [Works]
2/look through string/array and find that column in wb1 [Works]
3/then copy specific ranges to wb2 (name is based of column header/string value) [Works]
4/copy formula into column G, based on row similar to what it does for column A addresses - for example if the range is G9, it needs to copy the formula H9-A9, etc
5/go to next value
Any help or direction would be appreciated.
Sub Prepare_CYTD_Report()
Dim addresses() As String
Dim addresses2() As String
Dim wb1 As Workbook, wb2 As Workbook
Dim my_Filename
'Declare variables for MHP60
Dim i As Long, lastcol As Long
Dim tabNames As Range, cell As Range, tabName As String
'Declare variables for MHP61
Dim i2 As Long, lastCol2 As Long
Dim tabNames2 As Range, cell2 As Range, tabName2 As String
'Declare variables for MHP62
Dim i3 As Long, lastCol3 As Long
Dim tabNames3 As Range, cell3 As Range, tabName3 As String
addresses = Strings.Split("A9,A12:A26,A32:A38,A42:A58,A62:A70,A73:A76,A83:A90", ",") 'Trial Balance string values
addresses2 = Strings.Split("G9,G12:G26,G32:G38,G42:G58,G62:G70,G73:G76,G83:G90", ",") 'Prior Month string values
Set wb1 = ActiveWorkbook 'Trial Balance to Financial Statements Workbook
'*****************************Load Column Header Strings
lastcol = wb1.Sheets("MHP60").Cells(5, Columns.Count).End(xlToLeft).Column
On Error Resume Next
Set tabNames = wb1.Sheets("MHP60").Cells(4, 3).Resize(1, lastcol - 2).SpecialCells(xlCellTypeConstants)
'actual non-formula text values on row 4 from column C up to column lastCol'
On Error GoTo 0
If Err.Number <> 0 Then
MsgBox "No headers were found on row 4 of MHP60", vbCritical
Exit Sub
End If
lastCol2 = wb1.Sheets("MHP61").Cells(5, Columns.Count).End(xlToLeft).Column
On Error Resume Next
Set tabNames2 = wb1.Sheets("MHP61").Cells(4, 3).Resize(1, lastcol - 2).SpecialCells(xlCellTypeConstants)
'actual non-formula text values on row 4 from column C up to column lastCol'
On Error GoTo 0
If Err.Number <> 0 Then
MsgBox "No headers were found on row 4 of MHP61", vbCritical
Exit Sub
End If
lastCol3 = wb1.Sheets("MHP62").Cells(5, Columns.Count).End(xlToLeft).Column
On Error Resume Next
Set tabNames3 = wb1.Sheets("MHP62").Cells(4, 3).Resize(1, lastcol - 2).SpecialCells(xlCellTypeConstants)
'actual non-formula text values on row 4 from column C up to column lastCol'
On Error GoTo 0
If Err.Number <> 0 Then
MsgBox "No headers were found on row 4 of MHP62", vbCritical
Exit Sub
End If
'*****************************Open CYTD/FYTD files
my_Filename = Application.GetOpenFilename(fileFilter:="Excel Files,*.xl*;*.xm*", Title:="Select File to create Reports")
If my_Filename = False Then
Exit Sub
End If
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(my_Filename)
'*****************************Copy values to Financial statements workbook
For Each cell In tabNames
tabName = Strings.Trim(cell.Value2)
'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
If CStr(wb1.Sheets("MHP60").Evaluate("ISREF('[" & wb2.Name & "]" & tabName & "'!$A$1)")) = "True" Then
'If wb2 has a tab named for the value in tabName
For i = 0 To UBound(addresses)
wb2.Sheets(tabName).Range(addresses(i)).Value2 = wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Value2
'wb2.Sheets(tabName).Range(addresses2(i)).Value2 =
'Debug.Print "data for " & wb2.Sheets(tabName).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
Next i
Else
Debug.Print "A tab " & tabName & " was not found in " & wb2.Name
End If
Next cell
For Each cell In tabNames2
tabName2 = Strings.Trim(cell.Value2)
'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
If CStr(wb1.Sheets("MHP61").Evaluate("ISREF('[" & wb2.Name & "]" & tabName2 & "'!$A$1)")) = "True" Then
'If wb2 has a tab named for the value in tabName
For i = 0 To UBound(addresses)
wb2.Sheets(tabName2).Range(addresses(i)).Value2 = wb1.Sheets("MHP61").Range(addresses(i)).Offset(0, cell.Column - 1).Value2
'Debug.Print "data for " & wb2.Sheets(tabName2).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP61").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
Next i
Else
Debug.Print "A tab " & tabName2 & " was not found in " & wb2.Name
End If
Next cell
For Each cell In tabNames3
tabName3 = Strings.Trim(cell.Value2)
'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
If CStr(wb1.Sheets("MHP62").Evaluate("ISREF('[" & wb2.Name & "]" & tabName3 & "'!$A$1)")) = "True" Then
'If wb2 has a tab named for the value in tabName
For i = 0 To UBound(addresses)
wb2.Sheets(tabName3).Range(addresses(i)).Value2 = wb1.Sheets("MHP62").Range(addresses(i)).Offset(0, cell.Column - 1).Value2
'Debug.Print "data for " & wb2.Sheets(tabName2).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP62").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
Next i
Else
Debug.Print "A tab " & tabName3 & " was not found in " & wb2.Name
End If
Next cell
Application.ScreenUpdating = True
End Sub

Answer 1

Sub Prepare_CYTD_Report()
Dim addresses() As String
Dim wb1 As Workbook, wb2 As Workbook
Dim i As Long, lastCol As Long, my_FileName
Dim tabNames As Range, cell As Range, tabName As String
addresses = Strings.Split("A12:A26,A32:A38,A42:A58,A62:A70,A73:A76,A83:A90", ",")
Set wb1 = ActiveWorkbook 'Trial Balance to Financial Statements
lastCol = wb1.Sheets("MHP60").Cells(5, Columns.Count).End(xlToLeft).Column
On Error Resume Next
Set tabNames = wb1.Sheets("MHP60").Cells(4, 3).Resize(1, lastCol - 2).SpecialCells(xlCellTypeConstants)
'actual non-formula text values on row 4 from column C up to column lastCol'
On Error GoTo 0
If Err.Number <> 0 Then
MsgBox "No headers were found on row 4 of MHP60", vbCritical
Exit Sub
End If
'*****************************Open CYTD/FYTD files
my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
If my_FileName = False Then
Exit Sub
End If
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(my_FileName)
For Each cell In tabNames
tabName = Strings.Trim(cell.Value2)
'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
If CStr(wb2.Worksheets(1).Evaluate("ISREF('" & tabName & "'!$A$1)")) = "True" Then
'If wb2 has a tab named for the value in tabName
For i = 0 To UBound(addresses)
wb2.Sheets(tabName).Range(addresses(i)).Value2 = wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Value2
'Debug.Print "data for " & wb2.Sheets(tabName).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
Next i
Else
Debug.Print "A tab " & tabName & " was not found in " & wb2.Name
End If
Next cell
Application.ScreenUpdating = True
End Sub
In view of the observation made in my comment, the code presented above assumes that
the actual cell values on row 4 of MHP60 are the values 'as is' of
the actual tab names
those cell values were manually entered, i.e. not formula-driven