Sub COPIER()
Dim JB1, JB2, FSTRow, LSTRow, JB2ROW As String
JB1 = ActiveWorkbook.Name
'Open JB2
'--------
MsgBox "Please Open JB2", vbInformation, ""
FileToOpen = Application.GetOpenFilename _
(Title:="Please open JB2", _
FileFilter:="Excel Files *.xls (*.xls),")
If FileToOpen = False Then
MsgBox "No file specified. Macro will now exit.", vbCritical, ""
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
JB2 = ActiveWorkbook.Name
End If
Windows(JB1).Activate
Cells.Find(what:="Sl.").Activate
Do Until ActiveCell.Value = 1
ActiveCell.Offset(1, 0).Select
Loop
FSTRow = ActiveCell.Row
LSTRow = Cells(Rows.Count, "A").End(xlUp).Row
'Model - Product ID
Range("B" & FSTRow & ":B" & LSTRow).Copy
Windows(JB2).Activate
JB2ROW = Cells(Rows.Count, "E").End(xlUp).Row
Range("E" & JB2ROW + 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Description - Description
Windows(JB1).Activate
Range("C" & FSTRow & ":C" & LSTRow).Copy
Windows(JB2).Activate
Range("F" & JB2ROW + 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'QTY - QTY
Windows(JB1).Activate
Range("D" & FSTRow & ":D" & LSTRow).Copy
Windows(JB2).Activate
Range("H" & JB2ROW + 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Make - Supplier
Windows(JB1).Activate
Range("E" & FSTRow & ":E" & LSTRow).Copy
Windows(JB2).Activate
Range("G" & JB2ROW + 1).Select
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Macro completed", vbInformation, ""
End Sub