Copying from one workbook to another

J

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
780
Office Version
  1. 365
Hi,

Have the code below that I want to copy from one workbook to another is doing but the problem put all in the wrong rows, not according to the cell saying in the code is copying everything but staring in row 42 in right columns.


here is the code:

VBA Code: 
Sub Copyfrom_EXP12017_APINVOICE()
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\EXPENSES_TESTING\EXP12017_IMPORT\EXP12017.xlsm")
Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\EXPENSES_TESTING\EXPENSE_IMPORT.xlsm")
Set ws1 = Wb1.Worksheets("EXP12017")
Set ws2 = Wb2.Worksheets("EXPENSE")
Row = ws1.Range("A2").End(xlDown).Row
j = 2

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

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

'Copy Column B
j = 2
For i = 2 To Row
    ws1.Range("B" & i).Copy
    ws2.Activate
    ws2.Range("B4" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    ws1.Activate
    j = j + 1
Next i
'Copy Column F
'j = 2
'For i = 2 To Row
    'ws1.Range("F" & i).Copy

    'ws2.Activate
    'ws2.Range("B19" & j).Select
    'ActiveCell.PasteSpecial xlPasteValues
    'ws1.Activate
    'j = j + 1
'Next i

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

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


'Copy Column K
j = 2
For i = 2 To Row
    ws1.Range("K" & i).Copy
    ws2.Activate
    ws2.Range("D4" & 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


Putting all of t them row 42:

EXPENSE_IMPORT.xlsm
ABCD
42EXP1201745047133.766.69
43EXP12017450478.930.18
44EXP120174504758.451.15
45EXP120174504714.350.28
46EXP12017450477.40.15
47EXP120174504719.730.39
48EXP1201745047148.637.43
EXPENSE



Thank you,
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
josros60 said:
Hi,

Have the code below that I want to copy from one workbook to another is doing but the problem put all in the wrong rows, not according to the cell saying in the code is copying everything but staring in row 42 in right columns.


here is the code:

VBA Code: 
Sub Copyfrom_EXP12017_APINVOICE()
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\EXPENSES_TESTING\EXP12017_IMPORT\EXP12017.xlsm")
Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\EXPENSES_TESTING\EXPENSE_IMPORT.xlsm")
Set ws1 = Wb1.Worksheets("EXP12017")
Set ws2 = Wb2.Worksheets("EXPENSE")
Row = ws1.Range("A2").End(xlDown).Row
j = 2

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

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

'Copy Column B
j = 2
For i = 2 To Row
    ws1.Range("B" & i).Copy
    ws2.Activate
    ws2.Range("B4" & j).Select
    ActiveCell.PasteSpecial xlPasteValues
    ws1.Activate
    j = j + 1
Next i
'Copy Column F
'j = 2
'For i = 2 To Row
    'ws1.Range("F" & i).Copy

    'ws2.Activate
    'ws2.Range("B19" & j).Select
    'ActiveCell.PasteSpecial xlPasteValues
    'ws1.Activate
    'j = j + 1
'Next i

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

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


'Copy Column K
j = 2
For i = 2 To Row
    ws1.Range("K" & i).Copy
    ws2.Activate
    ws2.Range("D4" & 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


Putting all of t them row 42:

EXPENSE_IMPORT.xlsm
ABCD
42EXP1201745047133.766.69
43EXP12017450478.930.18
44EXP120174504758.451.15
45EXP120174504714.350.28
46EXP12017450477.40.15
47EXP120174504719.730.39
48EXP1201745047148.637.43
EXPENSE



Thank you,
Click to expand...
it hard to say what wrong when your problem not cleary but i can change your code like this:
VBA Code: 
Sub Copyfrom_EXP12017_APINVOICE()
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lr As Long, i As Long
    Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\EXPENSES_TESTING\EXP12017_IMPORT\EXP12017.xlsm")
    Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\EXPENSES_TESTING\EXPENSE_IMPORT.xlsm")
    Set ws1 = Wb1.Worksheets("EXP12017")
    Set ws2 = Wb2.Worksheets("EXPENSE")
    lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row 'your old code had duplicate "Row" variable with VBA, and it just find to next empty cell, that means if in row A has empty cell, it will stop at that
    'because you set j=2 and it equal to i so i change it to 40+i, that mean ws2 start at row 42
    'i deleted all "select" and "activate" because we don't need them and its made code run slower
    For i = 2 To lr
        ws2.Range("A" & 40 + i).Value = ws1.Range("A" & i).Value
        ws2.Range("B" & 40 + i).Value = ws1.Range("B" & i).Value
        ws2.Range("A" & 190 + i).Value = ws1.Range("I" & i).Value 'you copy value from column I of ws1 to row 192 column A of ws2 right?
        ws2.Range("C" & 40 + i).Value = ws1.Range("J" & i).Value
        ws2.Range("D" & 40 + i).Value = ws1.Range("K" & i).Value
    Next i
    Set Wb1 = Nothing
    Set Wb2 = Nothing
    Set ws1 = Nothing
    Set ws1 = Nothing
    Row = 0
    i = 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
Thank you for the response.

What I Want is data from ws1 from row to copy to ws2
ej.

ws1 A2 down to ws2 row A4 down
ws1 B2 down to ws2 row B4 down
ws1 J2 down to ws2 row C4 down
ws1 K2 down to ws2 row D4 down
ws1 I2 down to ws2 row A19 down


Workbooks:

WS1

EXP12017.xlsm
ABIJKL
1Invoice NumberDateLine DescriptionSubtotalGSTTotal
2EXP120175/1/2023 0:00Truck fuel133.766.69140.45
3EXP120175/1/2023 0:00Lunch Wts Thursday8.930.189.11
4EXP120175/1/2023 0:00Dinner WTS Friday58.451.1559.6
5EXP120175/1/2023 0:00Dinner WTS Friday14.350.2814.63
6EXP120175/1/2023 0:00Breakfast Wts Saturday7.40.157.55
7EXP120175/1/2023 0:00Lunch wts friday19.730.3920.12
8EXP120175/1/2023 0:00Truck fuel148.637.43156.06
EXP12017



WS2

EXPENSE_IMPORT.xlsm
ABCD
2Account NumberBill DateMonthlyHST
3Services
4
5
6
7
8
9
10
11
12
13
14Total--
15
16credit balance?-
17
18Account GL Code NET INV LINE
19
20
21
22
23
24
EXPENSE
Cell Formulas
RangeFormula
C14:D14C14=SUM(C5:C8)
C16C16=SUM(C14:C14)


Thank you
 
Upvote 0
josros60 said:
Thank you for the response.

What I Want is data from ws1 from row to copy to ws2
ej.

ws1 A2 down to ws2 row A4 down
ws1 B2 down to ws2 row B4 down
ws1 J2 down to ws2 row C4 down
ws1 K2 down to ws2 row D4 down
ws1 I2 down to ws2 row A19 down


Workbooks:

WS1

EXP12017.xlsm
ABIJKL
1Invoice NumberDateLine DescriptionSubtotalGSTTotal
2EXP120175/1/2023 0:00Truck fuel133.766.69140.45
3EXP120175/1/2023 0:00Lunch Wts Thursday8.930.189.11
4EXP120175/1/2023 0:00Dinner WTS Friday58.451.1559.6
5EXP120175/1/2023 0:00Dinner WTS Friday14.350.2814.63
6EXP120175/1/2023 0:00Breakfast Wts Saturday7.40.157.55
7EXP120175/1/2023 0:00Lunch wts friday19.730.3920.12
8EXP120175/1/2023 0:00Truck fuel148.637.43156.06
EXP12017



WS2

EXPENSE_IMPORT.xlsm
ABCD
2Account NumberBill DateMonthlyHST
3Services
4
5
6
7
8
9
10
11
12
13
14Total--
15
16credit balance?-
17
18Account GL Code NET INV LINE
19
20
21
22
23
24
EXPENSE
Cell Formulas
RangeFormula
C14:D14C14=SUM(C5:C8)
C16C16=SUM(C14:C14)


Thank you
Click to expand...
in that case you shold change the code like this:
VBA Code: 
Sub Copyfrom_EXP12017_APINVOICE()
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lr As Long, i As Long
    Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\EXPENSES_TESTING\EXP12017_IMPORT\EXP12017.xlsm")
    Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\EXPENSES_TESTING\EXPENSE_IMPORT.xlsm")
    Set ws1 = Wb1.Worksheets("EXP12017")
    Set ws2 = Wb2.Worksheets("EXPENSE")
    lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lr
        ws2.Range("A" & 2 + j).Value = ws1.Range("A" & i).Value 'i=2 so you need to set it start with 2+i =4
        ws2.Range("B" & 2 + i).Value = ws1.Range("B" & i).Value 'same as above
        ws2.Range("A" & 17 + i).Value = ws1.Range("I" & i).Value 'set it to 17+i=19
        ws2.Range("C" & 2 + i).Value = ws1.Range("J" & i).Value 'same as above
        ws2.Range("D" & 2 + i).Value = ws1.Range("K" & i).Value 'same as above
    Next i
    Set Wb1 = Nothing
    Set Wb2 = Nothing
    Set ws1 = Nothing
    Set ws1 = Nothing
    Row = 0
    i = 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
eiloken said:
in that case you shold change the code like this:
VBA Code: 
Sub Copyfrom_EXP12017_APINVOICE()
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Dim Wb1 As Workbook, Wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lr As Long, i As Long
    Set Wb1 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\EXPENSES_TESTING\EXP12017_IMPORT\EXP12017.xlsm")
    Set Wb2 = Workbooks.Open("C:\Users\jose.rossi\Desktop\Excel Files\EXPENSES_TESTING\EXPENSE_IMPORT.xlsm")
    Set ws1 = Wb1.Worksheets("EXP12017")
    Set ws2 = Wb2.Worksheets("EXPENSE")
    lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lr
        ws2.Range("A" & 2 + j).Value = ws1.Range("A" & i).Value 'i=2 so you need to set it start with 2+i =4
        ws2.Range("B" & 2 + i).Value = ws1.Range("B" & i).Value 'same as above
        ws2.Range("A" & 17 + i).Value = ws1.Range("I" & i).Value 'set it to 17+i=19
        ws2.Range("C" & 2 + i).Value = ws1.Range("J" & i).Value 'same as above
        ws2.Range("D" & 2 + i).Value = ws1.Range("K" & i).Value 'same as above
    Next i
    Set Wb1 = Nothing
    Set Wb2 = Nothing
    Set ws1 = Nothing
    Set ws1 = Nothing
    Row = 0
    i = 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Click to expand...
Thank you so much. Worked like charm.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
2
Views
227
B-radK
B
F
  • Solved
Simplifying a code
Replies
6
Views
264
MARK858
MARK858
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
173
sspatriots
S
S
  • Question
Trying to resize a table to match the number of rows in another table
Replies
5
Views
68
sspatriots
S
P
  • Question
Code used for comparison between 2 list.
Replies
3
Views
318
Tupe77
T

Forum statistics

Threads
1,215,094
Messages
6,123,071
Members
449,092
Latest member
ipruravindra

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