Sub OpenBookTest3()
 
Dim Obook As Workbook
Dim Dbook As Workbook
Dim sTrVal As String
Dim sTrVal2 As String
 
' OBook is already open
Sheets("Supplier Feeds").Activate
Set Obook = ActiveWorkbook
 
‘ Col B Contains a list of Suppliers workbook names
Range("b2").Select
Do Until IsEmpty(Cells(ActiveCell.Row, "B"))
 
sTrVal = ActiveCell.Value ‘ Supplier workbook
sTrVal2 = ActiveCell.Offset(0, -1).Value ‘ Supplier Name
Set Dbook = Workbooks.Open("C:\Users\Bob\Desktop\DataFolder\" & sTrVal & ".xlsx")
 
‘Get Some Ranges
LastRow = Cells(Rows.Count, "a").End(xlUp).Row
 
Set RngA = Range("a2:a" & LastRow)
Set RngE = Range("e2:e" & LastRow)
Set RngF = Range("f2:f" & LastRow)
Set RngG = Range("g2:g" & LastRow)
Set RngY = Range("Y2:y" & LastRow)
Set RngZ = Range("z2:z" & LastRow)
 
'Grab Certain Columns
Set SrcRng = Application.Union(RngA, RngE, RngF, RngG, RngY, RngZ)
 
Set destRng = Obook.Sheets(sTrVal2).Cells(Rows.Count, "A").End(xlUp)(2)
Dbook.Activate
SrcRng.Copy _
Destination:=destRng
 
Dbook.Close SaveChanges:=False
Application.DisplayAlerts = False
 
ActiveCell.Offset(1, 0).Select
Loop
 
End Sub

 
 
‘Get Some Ranges
LastRow = Cells(Rows.Count, "a").End(xlUp).Row
 
Set RngA = Range("a2:a" & LastRow)
Set RngE = Range("e2:e" & LastRow)
Set RngF = Range("f2:f" & LastRow)
Set RngG = Range("g2:g" & LastRow)
Set RngY = Range("Y2:y" & LastRow)
Set RngZ = Range("z2:z" & LastRow)
 
'Grab Certain Columns
Set SrcRng = Application.Union(RngA, RngE, RngF, RngG, RngY, RngZ)
 
' Return to Sub OpenTest3