Shift range on a macro

[starfoxx]

Hello, here is the problem at hand.

I have 2 worksheets and I want to copy and transpose certain cells from Sheet 1 to Sheet 2.

This is a very repetitive process (up to 3000 cells) so I want to create a macro to do it, so far this is what I have come up with

Sub Macro()
    
        Dim ws1 As Worksheet
        Dim ws2 As Worksheet
        Dim r1 As Range
        Dim r2 As Range
        Set ws1 = ThisWorkbook.Worksheets(1)
        Set ws2 = ThisWorkbook.Worksheets(2)
        Set r1 = ws1.Range("C2,G2,K2")
        Set r2 = ws2.Range("D2")
        
        
        
        For cuenta = 1 To 3
        
            r1.Copy
            r2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=True
            
             r1.Offset(1, 0).Activate
            
            
            
            'r2.Offset(90, 0).Select
        Next cuenta
            
                        

End Sub

As you can see, I am trying to offset range 1 (on the 1st ws) by 1 row for each iteration of the for loop and range 2 by 90 rows for each iteration of the loop, however I do not know how to do this, can you please help me

Thanks a bunch

 

[Jonmo1]

Welcome to the board...

Try changing

r1.Offset(1, 0).Activate
r2.Offset(90, 0).Select
to

Set r1 = r1.Offset(1, 0)
Set r2 = r2.Offset(90, 0)


Hope that helps.

 

[id107]

Does this help?

Sub Macro()
    
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim r1 As Range
    Dim r2 As Range
 
    Set ws1 = ThisWorkbook.Worksheets(1)
    Set ws2 = ThisWorkbook.Worksheets(2)
    Set r1 = ws1.Range("C2,G2,K2")
    Set r2 = ws2.Range("D2")
 
    For cuenta = 1 To 3
        r1.Copy
        r2.PasteSpecial Paste:=xlPasteValues
        Set r1 = r1.Offset(1, 0)
        Set r2 = r2.Offset(90, 0)
    Next cuenta
 
End Sub

 

[starfoxx]

Thanks a lot jonmo1

That worked!!!

 

[starfoxx]

Thank you very much ID107

 

[Jonmo1]

Glad to help....

Perhaps even this to eliminate 2 un needed lines of code...

Sub Macro()
    
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim r1 As Range
Dim r2 As Range
Dim cuenta As Long
Set ws1 = ThisWorkbook.Worksheets(1)
Set ws2 = ThisWorkbook.Worksheets(2)
Set r1 = ws1.Range("C2,G2,K2")
Set r2 = ws2.Range("D2")
For cuenta = 0 To 2
    r1.Offset(cuenta, 0).Copy
    r2.Offset(cuenta * 90, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Next cuenta
End Sub