copy data from one workbook to another

fowzan

Board Regular
Joined
Aug 5, 2015
Messages
59
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.
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,176
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top