copy data from one workbook to another
Results 1 to 3 of 3

Thread: copy data from one workbook to another
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Aug 2015
    Posts
    59
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default copy data from one workbook to another

    HI,
    i have been using excel to create invoices. unfortunately i had to change the format of the invoice and add some more details to it.
    the problem i am facing now is i have to change all the old invoices as well (around 150+).

    i am looking to create a user form to do this.

    old workbook cell = New workbook cell
    Code:
    g9 = f10
    k9 = j10
    g10 = e8
    g7 = h8
    h8 = h7
    k7 = h9
    a9 = k8
    c7 = L2
    a8 = k3
    b12:b22 = b12:b22
    f12:f22 = f12:f22
    g12:g22 = k12:k22
    additionally all the invoices are saved with the invoice number as the file name which would be the value in cell E8.
    can i make a user form to do this?
    1. open old invoice (source workbook, which will be different in all transactions)
    2. open new invoice (destination workbook, which would be same for all transactions)
    3. run code which would copy required data and save the new invoice (destination workbook) with the file name as the value in cell E8.

  2. #2
    Board Regular
    Join Date
    Sep 2009
    Location
    CT, USA
    Posts
    303
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: copy data from one workbook to another

    Try this. Put this in a new, separate Excel file and set the paths and template filename. When you run OpenSeveralFiles, it will let you pick multiple files, open them one file at a time with a template and copy the information from the old info to the template and save based on the name in E8.

    Code:
    Sub OpenSeveralFiles()'modified from http://www.wiseowl.co.uk/blog/s209/multiselect.htm
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim fd As FileDialog
    Dim FileChosen As Integer
    Dim fileName As String
    Dim i As Integer
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    'use the standard title and filters, but change the initial folder
    fd.InitialFileName = "c:\temp\"
    fd.InitialView = msoFileDialogViewList
    'allow multiple file selection
    fd.AllowMultiSelect = True
    FileChosen = fd.Show
    If FileChosen = -1 Then
        'open each of the files chosen
        For i = 1 To fd.SelectedItems.Count
            Workbooks.Open fd.SelectedItems(i)
            Call CopyRanges(fso.GetFileName(fd.SelectedItems(i)))
        Next i
    End If
    Application.ScreenUpdating = True
    End Sub
    
    
    Sub CopyRanges(OldFile)
    'http://www.mrexcel.com/forum/excel-questions/904192-copy-data-one-workbook-another.html
    Dim TestString As String
    Dim Test As Variant
    Dim TemplatePath As String
    Dim Template As String
    Dim Savepath As String
    Application.ScreenUpdating = False
    TemplatePath = "C:\temp\"
    Template = "template.xlsm"
    Savepath = "C:\Temp\"
    Workbooks.Open fileName:=TemplatePath + Template
    Test = Array("g9", "f10", "k9", "j10", "g10", "e8", "g7", "h8", "h8", "h7", "k7", "h9", "a9", "k8", "c7", "L2", "a8", "k3")
    'Test = Split(TestString, ", ")
    For i = 0 To 17 Step 2
        Workbooks(Template).Sheets("Sheet1").Range(Test(i + 1)) = Workbooks(OldFile).Sheets("Sheet1").Range(Test(i))
    Next
    Workbooks(OldFile).Sheets("Sheet1").Range("b12:b22").Copy _
            Destination:=Workbooks(Template).Sheets("Sheet1").Range("b12:b22")
        Workbooks(OldFile).Sheets("Sheet1").Range("f12:f22").Copy _
            Destination:=Workbooks(Template).Sheets("Sheet1").Range("f12:f22")
        Workbooks(OldFile).Sheets("Sheet1").Range("g12:g22").Copy _
            Destination:=Workbooks(Template).Sheets("Sheet1").Range("k12:k22")
    SaveFile = Range("E8") + ".xlsm"
    Workbooks(Template).SaveAs fileName:=Savepath + SaveFile, FileFormat:=52
    '51 = xlOpenXMLWorkbook (without macro's in 2007-2013, xlsx)
    '52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2013, xlsm)
    '50 = xlExcel12 (Excel Binary Workbook in 2007-2013 with or without macro's, xlsb)
    '56 = xlExcel8 (97-2003 format in Excel 2007-2013, xls)
    Workbooks(SaveFile).Close SaveChanges:=True
    Workbooks(OldFile).Close SaveChanges:=False
    End Sub
    Good Luck!
    Bill

    Low intermediate VBA user - I know just enough to be dangerous. Trying to learn by doing.

    Use http://tableizer.journalistopia.com/ to show your worksheets in this forum.

  3. #3
    Board Regular
    Join Date
    Aug 2015
    Posts
    59
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: copy data from one workbook to another

    thanks @portews.
    i managed to get it done with this code

    Code:
    Sub openfile()
    Set wbOpen = Workbooks.Open _
    ("F:\Docs\Invoices\" & Range("b7"))
    End Sub
    
    Sub opennewinvoice()
    Set wbOpen = Workbooks.Open _
    ("F:\Docs\Invoices\Copy of Invoice 2.xlsm")
    End Sub
    
    Sub copy_data()
    Dim x As Workbook
    Dim y As Workbook
    Dim FName           As String
    Dim FPath           As String
    
    
    FPath = "F:\Docs\Invoices\New Invoices"
    
    
    '## Open both workbooks first:
    Set x = Workbooks.Open("F:\HealerCart\Invoices\" & Range("b7"))
    Set y = Workbooks.Open("F:\HealerCart\Invoices\Copy of Invoice 2.xlsm")
    Set ws1 = x.Sheets("Sheet1")
    Set ws2 = y.Sheets("Invoice")
    
    
    'Order Date
    ws1.Range("G9").Copy
    ws2.Range("F10").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    
    'Customer ID
    ws1.Range("c7").Copy
    ws2.Range("l2").PasteSpecial
    Application.CutCopyMode = False
    
    
    'Invoice Date
    ws1.Range("k9").Copy
    ws2.Range("j10").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    
    
    'Order No.
    ws1.Range("g10").Copy
    ws2.Range("e8").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    'Delivery Date
    ws1.Range("g7").Copy
    ws2.Range("h8").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    'Patient Name
    ws1.Range("G8").Copy
    ws2.Range("h7").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    'Billing Address
    ws1.Range("k7").Copy
    ws2.Range("h9").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    'Delivery Address
    ws1.Range("A9").Copy
    ws2.Range("o10").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    ws1.Range("A10").Copy
    ws2.Range("p10").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
       
    'Name
    ws1.Range("A8").Copy
    ws2.Range("K3").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    
    
    'ProdName
    ws1.Activate
    Range("B12").Select
    ws1.Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Selection.Copy
    ws2.Activate
    Range("b12").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    'Quantity
    ws1.Activate
    Range("g12").Select
    ws1.Range(ActiveCell, ActiveCell.End(xlDown)).Select
    Selection.Copy
    ws2.Activate
    Range("g12").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    'save the target book
    FName = Sheets("Invoice").Range("e8").Text
    y.SaveAs filename:=FPath & "\" & FName
    
    
     End Sub

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •