Looping Macro

kopower

Board Regular
Joined
Nov 29, 2014
Messages
52
I am hoping someone can help me I have been trying to do a loop but cannot figure it out. I have two workbooks the first workbook is called Summary.xlsx , in this workbook I have rows of information which I would like to pull into another workbook. What I would like to do is copy the information from the last row in column A paste it into workbook 2 the then go to the next row in column A and paste it in workbook 2, then next row in column A paste into workbook 2 etc until there is no more data in column A. My looping code that I have is as follows;

Set myData = Workbooks("Summary.xlsx")

Set sh1 = ThisWorkbook.Sheets("Option")
Set sh2 = myData.Sheets("Summary")


finalrow = sh2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To finalrow

"I have code that goes in here and the code works and copies it over to workbook in sh1 no problem"

next i

The code will copy the A1 but will not go to A2 it keeps repeating A1.

Hoping someone can help identify what I am doing wrong.

I am hoping this makes sense the code I have in the middle is pretty big and works but it will not grab the A2, A3, A4 etc

Thanks in advance for any suggestions and help

KO
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Need to see the code you have omitted to help properly but to start with if you want to "copy the information from the last row in column A" then
Code:
For i = 1 To finalrow
should be
Code:
For i = finalrow To 1 Step - 1
but then you say it is copying from A1 correctly which would mean your previous statement above is incorrect :confused:
 
Upvote 0
It looks like you are using the destination sheet as the basis for your loop, in which case there would only be 1 row !!
If you step through the code manually using F8, what number do you have when you hover over "finalrow" ?

finalrow = sh2.Cells(Rows.Count, 1).End(xlUp).Row
I just have a feeling it should be

finalrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
.....not sh2
 
Upvote 0
Hi Mark

I tried your suggestion but that gave me same result, listed below is my code there are two loops the "C" loop brings everything from Sh2 to Sh1, this works and starts at A1. Now what I would like to do is after it goes through the process I want it to take A2 from Sh2 and drop it in Sh1 and continue to do this until there is no more information in Column A


Code:
Application.ScreenUpdating = False
Application.EnableEvents = False
'
'ActiveWorkbookPath = Thisworkbook.Path & "\" & Thisworkbook.Name
Set myData = Workbooks("Summary.xlsx")

Set sh1 = Thisworkbook.Sheets("Option")
Set sh2 = myData.Sheets("Summary")
'
Application.ScreenUpdating = False
Dim MyRng As Range
Dim i As Integer
finalrow = sh2.Cells(Rows.Count, "A").End(xlUp).Row
Set MyRng = sh2.Range("A1:A3")
For i = 1 To MyRng.Rows.Count

    Application.EnableEvents = False
 
   For C = 1 To 2 'change the numbers to suit
   sh2.Cells(C).Copy
   sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues
Next C
For C = 4 To 6 'change the numbers to suit
   sh2.Cells(C).Copy
   sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues
Next C

Next i

What is happening is it goes through the code3 times which makes sense as for testing I just captured A1 to A3 however it only takes A1 value times as opposed to going A1, then A2, then A3

I only showed part of the code as it is very long code but I hope what I am saying makes sense.

Hoping you can pot my problem :)

KO
 
Upvote 0
So just to be clear...
You want to to copy from A2 in sh2 to the last cell with data in column A sh2 and paste values in sh1?

drop it in Sh1
drop it where in sh1?
 
Upvote 0
So just to be clear...
You want to to copy from A2 in sh2 to the last cell with data in column A sh2 and paste values in sh1?


drop it where in sh1?

Hi Mark,

Just to give you a little explanation of the For C loop as this is what is getting dropped into Sh1.

Sh1 = one of the workbooks, this is where the information from Sh2 is getting dropped into.

Sh2 has all of the information in columns
in the code "C" is referencing column numbers so C1 to C2 is A1 to B1, C4 to C6 is D1 to F1.
As you can see in the code these are copied from Sh2 then pasted in Sh1 (workbook) in column d and down into cell 4. So what it is doing is it is taking the value of C which is in A1 (C1) and pasting it into Sh1 column D and adding 3 spots so 1 + 3 = 4 therefore D4. So in the C1 to C2 it pasting it into Sh1 D4 and D5.

This all works great, now what I am trying to do is do a loop that will take A1 in Sh2 and paste into Sh1 then loop to take A2 in Sh2 and drop it is the same spot so for the example provided it in theory is over writing the information that has come over from A1. That is OK as the code is much larger than what I have provided so there are more things going on so the information in A1 will be performing another task before it A2 comes over. But my problem is that it only bring over A1 it does not go to A2 and so on.

I do not understand why it does not go to A2, it keeps copy the information from A1 in tis example 3 times where it should be doing A1, then A2 then A3.

Hopefully I am making sense :)

KO
 
Upvote 0
Code:
    Dim myCell As Range
    For Each myCell In sh2.Range("A1:A" & sh2.Range("A" & Rows.Count).End(xlUp).Row)
        sh1.Range("[COLOR="#FF0000"]A1[/COLOR]").Value = myCell.Value 'Change A1 to suit
    End With

drop it is the same spot

You still didn't state where this is so change the red A1 in the above to suit.
 
Upvote 0
Hi Mark,

Just to give you a little explanation of the For C loop as this is what is getting dropped into Sh1.

Sh1 = one of the workbooks, this is where the information from Sh2 is getting dropped into.

Sh2 has all of the information in columns
in the code "C" is referencing column numbers so C1 to C2 is A1 to B1, C4 to C6 is D1 to F1.
As you can see in the code these are copied from Sh2 then pasted in Sh1 (workbook) in column d and down into cell 4. So what it is doing is it is taking the value of C which is in A1 (C1) and pasting it into Sh1 column D and adding 3 spots so 1 + 3 = 4 therefore D4. So in the C1 to C2 it pasting it into Sh1 D4 and D5.

This all works great, now what I am trying to do is do a loop that will take A1 in Sh2 and paste into Sh1 then loop to take A2 in Sh2 and drop it is the same spot so for the example provided it in theory is over writing the information that has come over from A1. That is OK as the code is much larger than what I have provided so there are more things going on so the information in A1 will be performing another task before it A2 comes over. But my problem is that it only bring over A1 it does not go to A2 and so on.

I do not understand why it does not go to A2, it keeps copy the information from A1 in tis example 3 times where it should be doing A1, then A2 then A3.

Hopefully I am making sense :)

KO

If you just need the values in the cells you can use this. If you're pulling formulas it will only capture the value

Code:
Sub CopySheet()




    Dim arr
    Dim i As Long, x As Long
    
    arr = Worksheets("Summary").UsedRange
    Worksheets("Option").Select
    For x = LBound(arr, 1) To UBound(arr, 1)
        For i = LBound(arr, 2) To UBound(arr, 2)
            ActiveCell.Offset(x - 1, i - 1).Value = arr(x, i)
        Next
    Next
    Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
    
End Sub



Also If the main goal is just about moving the data you could try this one


Code:
Sub Copypage()
ActiveSheet.UsedRange.Copy
Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
 
Last edited:
Upvote 0
Hi Mark

I tried your suggestion but that gave me same result, listed below is my code there are two loops the "C" loop brings everything from Sh2 to Sh1, this works and starts at A1. Now what I would like to do is after it goes through the process I want it to take A2 from Sh2 and drop it in Sh1 and continue to do this until there is no more information in Column A


Code:
Application.ScreenUpdating = False
Application.EnableEvents = False
'
'ActiveWorkbookPath = Thisworkbook.Path & "\" & Thisworkbook.Name
Set myData = Workbooks("Summary.xlsx")

Set sh1 = Thisworkbook.Sheets("Option")
Set sh2 = myData.Sheets("Summary")
'
Application.ScreenUpdating = False
Dim MyRng As Range
Dim i As Integer
finalrow = sh2.Cells(Rows.Count, "A").End(xlUp).Row
Set MyRng = sh2.Range("A1:A3")
For i = 1 To MyRng.Rows.Count

    Application.EnableEvents = False
 
   For C = 1 To 2 'change the numbers to suit
   sh2.Cells(C).Copy
   sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues
Next C
For C = 4 To 6 'change the numbers to suit
   sh2.Cells(C).Copy
   sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues
Next C

Next i

What is happening is it goes through the code3 times which makes sense as for testing I just captured A1 to A3 however it only takes A1 value times as opposed to going A1, then A2, then A3

I only showed part of the code as it is very long code but I hope what I am saying makes sense.

Hoping you can pot my problem :)

KO

This code worked for me, it pasted the contents of sheet 2 cell A1 and B1 to cells d4 and d5

The first instance of

Sh2.Cells(C).Copy = Copy A1

sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues ----------Since C+3 = 1+3 and joined with D then D4

Sh2.Cells(C).Copy = Cells(2) = Copy B2
sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues -----------Since C+3 = 2+3 and joined with D then D5]

And for the next loop 4 to 6 youre copying D2, E2, F2
And pasting it to D7, D8, D9

It all worked fine for me.
If you're trying to loop them over the same spot on a different page
Then you could try
sh1.Cells(i, c).PasteSpecial Paste:=xlPasteValues
instead of so in the first instance it will take A1 and past it to Cells(1,1) which is A1 on the other sheet
sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues
I might have updated the code a bit, but this one worked for me

Code:
Sub Copypage()


    Set sh1 = ActiveSheet
    Set sh2 = Worksheets("Sheet2")
    
    Dim MyRng As Range
    Dim i As Integer
    
    finalrow = sh2.Cells(Rows.Count, "A").End(xlUp).Row
    Set MyRng = sh2.Range("A1:A3")
    
    For i = 1 To MyRng.Rows.Count
       For C = 1 To 2 'change the numbers to suit
       sh2.Cells(i, C).copy
       sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues
    Next C
    For C = 4 To 6 'change the numbers to suit
       sh2.Cells(i, C).copy
       sh1.Range("d" & C + 3).PasteSpecial Paste:=xlPasteValues
    Next C
    
    Next i
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,025
Messages
6,122,731
Members
449,093
Latest member
Mnur

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