one way, see if it helps you
Sub Test()
Application.ScreenUpdating = 0
Set wb1 = Workbooks.Open("C:\users\Sam\Desktop\Book1.xlsx") '***change for yr needs
wb1.Sheets(1).Range("f2:f" & Range("f" & Rows.Count).End(xlUp).Row).Copy
With ThisWorkbook.Sheets(1)
.Range("d" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
wb1.Sheets(1).Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row).Copy
With ThisWorkbook.Sheets(1)
.Range("e" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
wb1.Sheets(1).Range("e2:e" & Range("e" & Rows.Count).End(xlUp).Row).Copy
With ThisWorkbook.Sheets(1)
.Range("o" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
wb1.Sheets(1).Range("k2:k" & Range("k" & Rows.Count).End(xlUp).Row).Copy
With ThisWorkbook.Sheets(1)
.Range("i" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
wb1.Sheets(1).Range("s2:s" & Range("s" & Rows.Count).End(xlUp).Row).Copy
With ThisWorkbook.Sheets(1)
.Range("j" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
wb1.Close False
Application.CutCopyMode = False
Application.ScreenUpdating = 1
End Sub
Bookmarks