Copying Filtered Columns (non-adjacent) from one Table to end of another, but need to also add information in adjacent column of Destination Table

[sspatriots]

Hi,

This one may be difficult to explain. I have the code below that does exactly what my description states. That is, it will copy 4 filtered table columns from one table (the first column non-adjacent to the others) to the end of another table. It seems to do this nicely, although the code I have isn't probably the most efficient for doing this. Anyhow, once the data is pasted to the end of the destination table, I need to populate the cells in the column just to left of the newly inserted data with a word that comes from one of the source tables header titles.

Below is an image of the column in the new destination table called "Order_By_Report" that I need to populate at the same time with the word extraction from a column header on the source table called "G2JobList":

I need to extract "Machine" from the header in this table column: Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "Vendor")



Below is the code so far:

Sub PopulateOrderByReportWS()
'
' Populate Order By Report WS Macro
'

'
    Dim Ws1 As Worksheet
    Dim Ws2 As Worksheet
    Dim tb1 As ListObject
    Dim tb2 As ListObject
    Dim lc1 As ListColumn
    Dim lc2 As ListColumn
    Dim col1 As Long
    Dim col2 As Long
    Dim i As Long
    Dim lRw As Long
   
    Set Ws1 = Sheets("Jobs") 'Worksheet the G2JobList (Source) Table is on
    Set Ws2 = Sheets("Order By Report") 'Worksheet the Order_By_Report (Destination) Table is on
    Set tb1 = Ws1.ListObjects("G2JobList") 'Source Table
    Set tb2 = Ws2.ListObjects("Order_By_Report")  'Destination Table
    Set lc1 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "PO")
    Set lc2 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "Order By" & Chr(10) & "Date")
   
    col1 = lc1.Range.Column
    col2 = lc2.Range.Column

    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col1
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col2, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 7

    With tb1
   
        Range("G2JobList[[Job Name]], G2JobList[[MFR" & Chr(10) & "Machine" & Chr(10) & "PN]], G2JobList[[Machine" & Chr(10) & "Vendor]], G2JobList[[Machine" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy
   
        Ws2.Activate
   
        With Range("Order_By_Report[[Job Name]]")
            n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Cells(n + 1, .Column).PasteSpecial xlPasteValues
        End With
   
    End With

End Sub

Any help would be much appreciated. Thanks, SS

 

[sspatriots]

After many many attempts and tweaking, I came up with the following and it appears to do exactly as I needed. This is for anyone that might benefit from this in the future. Thanks to anyone that may have been looking into this or who may be following. SS

Sub PopulateOrderByReportWS()
'
' Populate Order By Report WS Macro
'
    Dim Ws1 As Worksheet
    Dim Ws2 As Worksheet
    Dim tb1 As ListObject
    Dim tb2 As ListObject
    Dim lc1 As ListColumn
    Dim lc2 As ListColumn
    Dim Rng1 As Range
    Dim col1 As Long
    Dim col2 As Long
    Dim i As Long
    Dim lRw As Long
    
    Set Ws1 = Sheets("Jobs") 'Worksheet the G2JobList (Source) Table is on
    Set Ws2 = Sheets("Order By Report") 'Worksheet the Order_By_Report (Destination) Table is on
    Set tb1 = Ws1.ListObjects("G2JobList") 'Source Table
    Set tb2 = Ws2.ListObjects("Order_By_Report")  'Destination Table
    Set lc1 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "PO")
    Set lc2 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "Order By" & Chr(10) & "Date")
    
    col1 = lc1.Range.Column
    col2 = lc2.Range.Column

    Ws2.Activate

    tb2.DataBodyRange.Delete

    Ws1.Activate
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col1
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col2, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 7

    With tb1
    
        Range("G2JobList[[Job Name]], G2JobList[[MFR" & Chr(10) & "Machine" & Chr(10) & "PN]], G2JobList[[Machine" & Chr(10) & "Vendor]], G2JobList[[Machine" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy
    
        Ws2.Activate
    
        With Range("Order_By_Report[[Job Name]]")
            n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Cells(n + 1, .Column).PasteSpecial xlPasteValues
            
            With tb2.Range.Borders()
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            
        End With
    
    End With
    
    For Each Rng1 In Ws2.Range("Order_By_Report[[Equipment]]")
        If Rng1 = vbNullString Then Rng1 = "Machine"
'        If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Machine" & Chr(10) & "Vendor")
    
        lRw = Cells(Rows.Count, 1).End(xlUp).Row
     
    Next
    
    Application.Goto Reference:=Range("A" & lRw), Scroll:=True

    Range("B3").Activate

End Sub