• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

COPY FROM ONE WORKBOOK TO ANOTHER

jack999

Member
I want to copy data from one Workbook to another workbook as workbook name JB1 TO JB2 (Workbook Uploaded)

copy start from where in column "A" start a number then COPY columns

JB1 "MODEL" TO JB2 PRODUT ID,
JB1 DESCRIPTION TO JB2 DESCRIPTION,
JB1 QTY TO JB2 QTY,
JB1 MAKE TO JB2 SUPPLIER
and upto last row
can someone to give a solution
 

Attachments

  • JB1.xlsx
    963.7 KB · Views: 2
  • JB2.xls
    28 KB · Views: 3
Macro assumes that JB1 column A always has numbers inside it & thus first row starts at 1. Macro will need to be run from JB1 and it will ask you to open JB2 later.
Code:
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
 
Back
Top