Copy columns from one workbook to another

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
786
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




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

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
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
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
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

Attachments

  • worksheets.jpg
    worksheets.jpg
    64 KB · Views: 18
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
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]

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

Forum statistics

Threads
1,224,595
Messages
6,179,799
Members
452,943
Latest member
Newbie4296

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