Copy columns from one workbook to another

J

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
781
Office Version
  1. 365
HI,

found the code below but only copy and paste the firs row and if I run again give run time error 9 subscript out of range.

code:

VBA Code: 
Sub Copyfrom_Workbook_Another()
Dim x As Workbook
Dim y As Workbook
Dim vals As Variant

'## Open both workbooks first:
Set x = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\2023 Bell CABS Payments.xlsm ")
Set y = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\X CTRX ON SAGE300 IMPORT FILE.xls ")

'Store the value in a variable:
vals = x.Sheets("Ctrx ON Mar").Range("A27").Value

'Use the variable to assign a value to the other file/sheet:
y.Sheets("Invoice_Details").Range("G2").Value = vals

'Close x:
'x.Close

End Sub

Here is the data copy from but only pasting this row:

519 376 4157-MAR23




2023 Bell CABS Payments.xlsm
ABCDE
26AccountGL code NET INV LINE TAX
27 519 376 4157-MAR23 60311010505100216.82128.13
28 519 376 4157-MAR23 603110-20-505-100 11.4111.48
29 519 524 2700-MAR23 60311010505100189.34224.57
30 519 524 2700-MAR23 603110-20-505-100 9.9721.29
31519 751 4490-MAR2360311010505100197.65325.65
32 519 751 4490-MAR23 603110-20-505-100 10.4031.35
33613 237 2362-MAR2360311010505100829.724107.83
34 613 237 2362-MAR23 603110-20-505-100 43.6745.68
35613 342 5950-MAR2360311010505100197.65525.65
36 613 342 5950-MAR23 603110-20-505-100 10.4051.35
37613 732 1180-MAR2360311010505100209.39627.20
38 613 732 1180-MAR23 603110-20-505-100 11.0261.43
39613 938 9000-MAR2360311010505100265.22734.38
40 613 938 9000-MAR23 603110-20-505-100 13.9671.81
41613 969 1023-MAR2360311010505100-8-
42 613 969 1023-MAR23 603110-20-505-100 -8-
43705 253 3004-MAR2360311010505100203.45926.40
44 705 253 3004-MAR23 603110-20-505-100 10.7191.39
45705 340 5055-MAR2360311010505100203.451026.40
46 705 340 5055-MAR23 603110-20-505-100 10.71101.39
47705 472 4947-MAR2360311010505100203.451126.40
48 705 472 4947-MAR23 603110-20-505-100 10.71111.39
49705 750 3055-MAR2360311010505100212.361227.55
50 705 750 3055-MAR23 603110-20-505-100 11.18121.45
51705 787 0060-MAR2360311010505100-13-
52 705 787 0060-MAR23 603110-20-505-100 -13-
53905 377 1055-MAR2360311010505100203.451426.40
54 905 377 1055-MAR23 603110-20-505-100 10.71141.39
Ctrx ON Mar
Cell Formulas
RangeFormula
A27A27=M7
B27,B29,B31,B33,B35,B37,B39,B41,B43,B45,B47,B49,B51,B53B27=$H$3
C27C27=H7
A28,A30,A32,A34,A36,A38,A40,A42,A44,A46,A48,A50,A52,A54A28=A27
B28,B30,B32,B34,B36,B38,B40,B42,B44,B46,B48,B50,B52,B54B28=$I$3
C28C28=I7
A29A29=M8
C29C29=H8
C30C30=I8
A31A31=M9
C31C31=H9
C32C32=I9
A33A33=M10
C33C33=H10
C34C34=I10
A35A35=M11
C35C35=H11
C36C36=I11
A37A37=M12
C37C37=H12
C38C38=I12
A39A39=M13
C39C39=H13
C40C40=I13
A41A41=M14
C41C41=H14
C42C42=I14
A43A43=M15
C43C43=H15
C44C44=I15
A45A45=M16
C45C45=H16
C46C46=I16
A47A47=M17
C47C47=H17
C48C48=I17
A49A49=M18
C49C49=H18
C50C50=I18
A51A51=M19
C51C51=H19
C52C52=I19
A53A53=M20
C53C53=H20
C54C54=I20
E27E27=D7*$H$4
E28E28=D7-E27
E29E29=D8*$H$4
E30E30=D8-E29
E31E31=D9*$H$4
E32E32=D9-E31
E33E33=D10*$H$4
E34E34=D10-E33
E35E35=D11*$H$4
E36E36=D11-E35
E37E37=D12*$H$4
E38E38=D12-E37
E39E39=D13*$H$4
E40E40=D13-E39
E41E41=D14*$H$4
E42E42=D14-E41
E43E43=D15*$H$4
E44E44=D15-E43
E45E45=D16*$H$4
E46E46=D16-E45
E47E47=D17*$H$4
E48E48=D17-E47
E49E49=D18*$H$4
E50E50=D18-E49
E51E51=D19*$H$4
E52E52=D19-E51
E53E53=D20*$H$4
E54E54=D20-E53


Thank you
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Are you copying the whole column of Data, to the other worksheet?
 
Upvote 0
Try this:

VBA Code: 
Sub Copyfrom_Workbook_Another()
Dim Wb1, Wb2 As Workbook
Dim Row, i, j As Long
Dim vals As Variant

'## Open both workbooks first:
Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\2023 Bell CABS Payments.xlsm ")
Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\X CTRX ON SAGE300 IMPORT FILE.xls ")
Row = Sheet7.Range("A27").End(xlDown).Row

j = 2

Application.ScreenUpdating = False
Application.EnableEvents = False

For i = 27 To Row
    Sheet5.Range("A" & Row, "C" & Row).Copy
    Wb2.Sheets("Invoice_Details").Activate
    Wb2.Sheets("Invoice_Details").Range("G" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    Wb1.Sheets("Ctrx ON Mar").Acivate
    j = j + 1
Next i

Application.ScreenUpdating = True
Application.EnableEvents = True

'Close x:
Wb1.Close

End Sub
 
Upvote 0
Skybluekid said:
Try this:

VBA Code: 
Sub Copyfrom_Workbook_Another()
Dim Wb1, Wb2 As Workbook
Dim Row, i, j As Long
Dim vals As Variant

'## Open both workbooks first:
Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\2023 Bell CABS Payments.xlsm ")
Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\X CTRX ON SAGE300 IMPORT FILE.xls ")
Row = Sheet7.Range("A27").End(xlDown).Row

j = 2

Application.ScreenUpdating = False
Application.EnableEvents = False

For i = 27 To Row
    Sheet5.Range("A" & Row, "C" & Row).Copy
    Wb2.Sheets("Invoice_Details").Activate
    Wb2.Sheets("Invoice_Details").Range("G" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    Wb1.Sheets("Ctrx ON Mar").Acivate
    j = j + 1
Next i

Application.ScreenUpdating = True
Application.EnableEvents = True

'Close x:
Wb1.Close

End Sub
Click to expand...
Hi,

thank you.

But when run the code giving error 438 and highlight this line:

VBA Code: 
[TABLE]
[TR]
[TD]Wb1.Sheets("Ctrx ON Mar").Acivate[/TD]

[TD][/TD]
[/TR]
[/TABLE]

I also change this line from:
VBA Code: 
Row = Sheet8.Range("A27").End(xlDown).Row

changed it from Sheet7 to Sheet8 which is the sheet #.

thanks again.
 
Upvote 0
What are the sheet numbers in your excel workbooks?
 
Upvote 0

Attachments

  • worksheets.jpg
    worksheets.jpg
    64 KB · Views: 8
Upvote 0
VBA Code: 
[CODE=vba]
Sub Copyfrom_Workbook_Another()
Dim Wb1, Wb2 As Workbook
Dim ws1, ws2 As Worksheet
Dim Row, i, j As Long

'Set Variables
Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\2023 Bell CABS Payments.xlsm")
Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\X CTRX ON SAGE300 IMPORT FILE.xls")
Set ws1 = Wb1.Worksheets("Sheet24")
Set ws2 = Wb2.Worksheets("'Enter Worksheet number here'")
Row = ws1.Range("A2").End(xlDown).Row
j = 2

'Stop Screen Updating
Application.ScreenUpdating = False
Application.EnableEvents = False

'Loop through Data Set
For i = 2 To Row
    ws1.Range("A" & i, "C" & i).Copy
    ws2.Activate
    ws2.Range("G" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    ws1.Activate
    j = j + 1
Next i

'Close Wb1
Wb1.Close

'Cancel Variables
Set Wb1 = Nothing
Set Wb2 = Nothing
Set ws1 = Nothing
Set ws1 = Nothing
Row = 0
i = 0
j = 0

'Restore Screen Updating
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
[/CODE]
 
Upvote 0
Skybluekid said:
VBA Code: 
[CODE=vba]
Sub Copyfrom_Workbook_Another()
Dim Wb1, Wb2 As Workbook
Dim ws1, ws2 As Worksheet
Dim Row, i, j As Long

'Set Variables
Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\2023 Bell CABS Payments.xlsm")
Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\X CTRX ON SAGE300 IMPORT FILE.xls")
Set ws1 = Wb1.Worksheets("Sheet24")
Set ws2 = Wb2.Worksheets("'Enter Worksheet number here'")
Row = ws1.Range("A2").End(xlDown).Row
j = 2

'Stop Screen Updating
Application.ScreenUpdating = False
Application.EnableEvents = False

'Loop through Data Set
For i = 2 To Row
    ws1.Range("A" & i, "C" & i).Copy
    ws2.Activate
    ws2.Range("G" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    ws1.Activate
    j = j + 1
Next i

'Close Wb1
Wb1.Close

'Cancel Variables
Set Wb1 = Nothing
Set Wb2 = Nothing
Set ws1 = Nothing
Set ws1 = Nothing
Row = 0
i = 0
j = 0

'Restore Screen Updating
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
[/CODE]
Click to expand...

Thank you so much, it worked.

Question I tried to modify it that can copy the 3 columns at once giving me run time-error 450
and highlight this line:

VBA Code: 
Row = ws1.Range("A27", "C27", "E27").End(xlDown).Row

Complete code modified:

VBA Code: 
Sub Copyfrom_Workbook_Another()
Dim Wb1, Wb2 As Workbook
Dim ws1, ws2 As Worksheet
Dim Row, i, j As Long

'Set Variables
Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\2023 Bell CABS Payments.xlsm")
Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\X CTRX ON SAGE300 IMPORT FILE.xls")
Set ws1 = Wb1.Worksheets("Ctrx ON Mar")
Set ws2 = Wb2.Worksheets("Invoice_Details")
Row = ws1.Range("A27", "C27", "E27").End(xlDown).Row
j = 2

'Stop Screen Updating
Application.ScreenUpdating = False
Application.EnableEvents = False

'Loop through Data Set
For i = 27 To Row
    ws1.Range("A" & i, "C" & i, "E" & i).Copy
    ws2.Activate
    ws2.Range("G" & j).Select
    ws2.Range("H" & j).Select
    ws2.Range("J" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    ws1.Activate
    j = j + 1
Next i

'Close Wb1
'Wb1.Close

'Cancel Variables
Set Wb1 = Nothing
Set Wb2 = Nothing
Set ws1 = Nothing
Set ws1 = Nothing
Row = 0
i = 0
j = 0

'Restore Screen Updating
Application.ScreenUpdating = True
Application.EnableEvents = True




End Sub
 
Upvote 0
Here is the Code to copy the non continuous Cells
VBA Code: 
Sub Copyfrom_Workbook_Another()
Dim Wb1, Wb2 As Workbook
Dim ws1, ws2 As Worksheet
Dim Row, i, j As Long

'Set Variables
Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\2023 Bell CABS Payments.xlsm")
Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\DCL_CAB INVOICES_BELL\X CTRX ON SAGE300 IMPORT FILE.xls")
Set ws1 = Wb1.Worksheets("Ctrx ON Mar")
Set ws2 = Wb2.Worksheets("Invoice_Details")
Row = ws1.Range("A27").End(xlDown).Row
j = 2

'Stop Screen Updating
Application.ScreenUpdating = False
Application.EnableEvents = False

'Copy Column A
For i = 27 To Row
    ws1.Range("A" & i).Copy
    ws2.Activate
    ws2.Range("G" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    ws1.Activate
    j = j + 1
Next i

'Copy Column C
For i = 27 To Row
    ws1.Range("C" & i).Copy
    ws2.Activate
    ws2.Range("H" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    ws1.Activate
    j = j + 1
Next i

'Copy Column E
For i = 27 To Row
    ws1.Range("E" & i).Copy
    ws2.Activate
    ws2.Range("J" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    ws1.Activate
    j = j + 1
Next i

'Close Wb1
Wb1.Close

'Cancel Variables
Set Wb1 = Nothing
Set Wb2 = Nothing
Set ws1 = Nothing
Set ws1 = Nothing
Row = 0
i = 0
j = 0

'Restore Screen Updating
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Need some help with permutation code, convert from one cell to a range
Replies
3
Views
269
johnnyL
J
J
  • Question
Excel macro for Remove comma's and spaces from a cell and place the data in different cell
Replies
3
Views
938
JEC
JEC
C
  • Question
Need Help with VBA Code - Copy data below and above a specific text
Replies
1
Views
736
onlyadrafter
O
S
  • Question
Filter the values.
Replies
6
Views
620
sekar_r24
S
R
  • Question
Help!
Replies
3
Views
1K
63falcondude
63falcondude

Forum statistics

Threads
1,215,452
Messages
6,124,914
Members
449,195
Latest member
Stevenciu

Share this page

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