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

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 wb1.Sheets(MHP60) tab. Each column header is a new tab in wb2. I can't figure out how to set the code up to read the string MHP60 and then if it finds the string, it needs to copy the values to that Sheet in wb2 and then move on to the next. I started with hard coding it, but it doesn't help if there are additional columns added. I checked some of the other posts but I don't see how to start. I feel like there is an easier way that I'm missing.

So the code needs to: 1/put the column headers to a string/array 2/look through string/array and find that column in wb1 3/then copy specific ranges to wb2 (name is based of column header/string value) 4/go to next value

Any help or direction would be appreciated.

Sub Prepare_CYTD_Report()

Dim wb1 As Workbook, wb2 As Workbook
Dim MHP60, MHP61, MHP62 As String
Dim i, j, lCol60, lCol61, lCol62 As Long 'last columns in MHP worksheets

Dim my_Filename

Application.ScreenUpdating = False

Set wb1 = ActiveWorkbook 'Trial Balance to Financial Statements

'lastCol61 = wb1.Sheets("MHP61").Cells(5, Columns.Count).End(xlToLeft).Column 'Find the last non-blank cell in header row
'lastCol62 = wb1.Sheets("MHP62").Cells(5, Columns.Count).End(xlToLeft).Column 'Find the last non-blank cell in header row

'*****************************Create Header Array for MHP60 tab
lastCol60 = wb1.Sheets("MHP60").Cells(5, Columns.Count).End(xlToLeft).Column 'Find the last non-blank cell in header row

ReDim MHP60(1 To lCol60)

For i = 3 To lCol60 Step 1
    If (Not IsEmpty(Cells(4, i).Value)) Then ' checks to make sure the value isn't empty
        j = j   1
        MHP60(j) = Cells(4, i).Value
    End If
Next i

ReDim Preserve MHP60(1 To j)

For j = LBound(MHP60) To UBound(MHP60)  ' loop through the previous array
    MHP60(j) = Replace(MHP60(j), " ", "")
    MHP60(j) = Replace(MHP60(j), ",", "")
Next j


'*****************************Open CYTD/FYTD files
my_Filename = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")

If my_Filename = False Then
    Exit Sub
End If

Set wb2 = Workbooks.Open(my_Filename) 'Monthly Report file


'*****************************Code to copy values to CYTD/FYTD Files

    'MHP60 - column C - 1009 SNP-F
    wb2.Sheets("1009 SNP-F").Range("A12:A26").Value = wb1.Sheets("MHP60").Range("C12:C26").Value
    wb2.Sheets("1009 SNP-F").Range("A32:A38").Value = wb1.Sheets("MHP60").Range("C32:C38").Value
    wb2.Sheets("1009 SNP-F").Range("A42:A58").Value = wb1.Sheets("MHP60").Range("C42:C58").Value
    wb2.Sheets("1009 SNP-F").Range("A62:A70").Value = wb1.Sheets("MHP60").Range("C62:C70").Value
    wb2.Sheets("1009 SNP-F").Range("A73:A76").Value = wb1.Sheets("MHP60").Range("C73:C76").Value
    wb2.Sheets("1009 SNP-F").Range("A83:A90").Value = wb1.Sheets("MHP60").Range("C83:C90").Value

    'MHP60 - column I - 1014 MA-PD-F
    wb2.Sheets("1014 MA-PD-F").Range("A12:A26").Value = wb1.Sheets("MHP60").Range("D12:D26").Value
    wb2.Sheets("1014 MA-PD-F").Range("A32:A38").Value = wb1.Sheets("MHP60").Range("D32:D38").Value
    wb2.Sheets("1014 MA-PD-F").Range("A42:A58").Value = wb1.Sheets("MHP60").Range("D42:D58").Value
    wb2.Sheets("1014 MA-PD-F").Range("A62:A70").Value = wb1.Sheets("MHP60").Range("D62:D70").Value
    wb2.Sheets("1014 MA-PD-F").Range("A73:A76").Value = wb1.Sheets("MHP60").Range("D73:D76").Value
    wb2.Sheets("1014 MA-PD-F").Range("A83:A90").Value = wb1.Sheets("MHP60").Range("D83:D90").Value
    
    'MHP60 - column I - 1061 ABAD-F
    wb2.Sheets("1061 ABAD-F").Range("A12:A26").Value = wb1.Sheets("MHP60").Range("E12:E26").Value
    wb2.Sheets("1061 ABAD-F").Range("A32:A38").Value = wb1.Sheets("MHP60").Range("E32:E38").Value
    wb2.Sheets("1061 ABAD-F").Range("A42:A58").Value = wb1.Sheets("MHP60").Range("E42:E58").Value
    wb2.Sheets("1061 ABAD-F").Range("A62:A70").Value = wb1.Sheets("MHP60").Range("E62:E70").Value
    wb2.Sheets("1061 ABAD-F").Range("A73:A76").Value = wb1.Sheets("MHP60").Range("E73:E76").Value
    wb2.Sheets("1061 ABAD-F").Range("A83:A90").Value = wb1.Sheets("MHP60").Range("E83:E90").Value
    
Application.ScreenUpdating = True

End Sub

CodePudding user response：

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