VBA loop not working

[youngbella]

Hi, I'm new to VBA.

I did some coding to do copy and paste but in loop.

However, the second loop is not running. is there something wrong with my code?
Basically, I have a list in "sheet2" and I want to copy and paste it to "sheet1" sheet and skipping few rows for each list.
Can someone help me??

Sub copypasteskip()

Dim sheet1 As Variant
Dim sheet2 As Variant
Dim endnumber As Integer
Dim finalrow As Variant
Dim i As Integer
Dim r As Integer


Set sheet1 = ThisWorkbook.Worksheets("June")
Set sheet2 = ThisWorkbook.Worksheets("ImportData")

endnumber = sheet1.Cells(Rows.Count, "A").End(xlUp).Row
finalrow = sheet2.Cells(Rows.Count, "D").End(xlUp).Row


For r = 11 To endnumber 'the list should paste starts at rows 11, cells "A"
        
        
        For i = 14 To finalrow 'the list need to be copy starts at rows 14,cells "D"
        
   
                sheet2.Cells(i, "D").End(xlDown).Copy
                sheet1.Cells(r, "A").PasteSpecial xlPasteValues
          
        
        Next i
        
       r = r + 7 'need to skips 7 rows for each list
    
Next r

End sub

 

[MARK858]

Do you actually need a 2nd loop, does the below do what you want? although being honest I'm not visualizing what trying to do with your copy range.

Sub copypasteskip()

    Dim sheet1 As Worksheet
    Dim sheet2 As Worksheet
    Dim finalrow As Long
    Dim i As Long
    Dim r As Long


    Set sheet1 = ThisWorkbook.Worksheets("June")
    Set sheet2 = ThisWorkbook.Worksheets("ImportData")

    finalrow = sheet2.Cells(Rows.Count, "D").End(xlUp).Row

    r = 11
        
    For i = 14 To finalrow                       'the list need to be copy starts at rows 14,cells "D"
        
  
        sheet2.Cells(i, "D").End(xlDown).Copy
        sheet1.Cells(r, "A").PasteSpecial xlPasteValues
          
        r = r + 7                                'need to skips 7 rows for each list
    Next i
        
      

End Sub

 

[youngbella]

I thought I need second loop. The ""sheet2.cells(i,"D").end(xlDown).copy"" code. This code should copy starting from the the ""i=14"" until the last cells of the list, right? but however, it only copy the last cell. is it my range wrong?

 

[youngbella]

And I need to update the ID list, I need to paste after the last row. I put it to ""sheet1.Cells(r, "A").End(xlUp).PasteSpecial xlPasteValues"". but its not working.

 

[MARK858]

You need to offset that line by 1 if you want the next blank row, that is why it appears to copy only the last cell... you are overwritng it.

sheet1.Cells(r, "A").End(xlUp).Offset(1).PasteSpecial xlValues

but that line is not in the code that I posted.

 

[steve the fish]

If im understanding maybe this:

Set sh1 = ThisWorkbook.Worksheets("June")
Set sh2 = ThisWorkbook.Worksheets("ImportData")
finalrow = sh2.Cells(sh2.Rows.Count, "D").End(xlUp).Row

If finalrow > 13 Then
    For i = 14 To finalrow Step 7
        sh1.Cells(i - 3, "A").Value = sh2.Cells(i, "D").Value
    Next i
End If

 

[youngbella]

You need to offset that line by 1 if you want the next blank row, that is why it appears to copy only the last cell... you are overwritng it.

sheet1.Cells(r, "A").End(xlUp).Offset(1).PasteSpecial xlValues

but that line is not in the code that I posted.

Oh..okay great. I've solved that copy problem but there will be another sheet of ID list coming (assuming all the rows and columns are in same place). And I need to paste it in the same sheet. I tried the End(xlup) but it didn't work. when I run the code, it will replace my previous ID list. I want it to paste below the previous id (find the last row and paste it).

Sub copypasteskip()

    Dim sheet1 As Worksheet
    Dim sheet2 As Worksheet
    Dim finalrow As Long
    Dim i As Long
    Dim r As Long


    Set sheet1 = ThisWorkbook.Worksheets("June")
    Set sheet2 = ThisWorkbook.Worksheets("ImportData")

    finalrow = sheet2.Cells(Rows.Count, "D").End(xlUp).Row
    
    
    r = sheet1.Range("A:A").End(xlUp).Row
    
    
    r = 11
        
    For i = 14 To finalrow
        
 
        sheet2.Cells(i, "D").Copy
        sheet1.Cells(r, "A").End(xlup).PasteSpecial xlPasteValues
        
          
        r = r + 8
    Next i
        
      

End Sub

 

[MARK858]

The End(xlup) in the line below does not belong in my code, you are mixing the 2 codes up.

 sheet1.Cells(r, "A").End(xlup).PasteSpecial xlPasteValues

The r is being incremented in the line below it.

Am I interpreting your question wrong?

Basically, I have a list in "sheet2" and I want to copy and paste it to "sheet1" sheet and skipping few rows for each list.
Can someone help me??

Do you want every 7th row (Sheet2) copied and pasted to the next row in Sheet1? or do do you want each row (Sheet2) copied and pasted to every 7th row in Sheet1?

Have you tested what @steve the fish posted?

 

[youngbella]

The End(xlup) in the line below does not belong in my code, you are mixing the 2 codes up.

 sheet1.Cells(r, "A").End(xlup).PasteSpecial xlPasteValues

The r is being incremented in the line below it.

Am I interpreting your question wrong?

Do you want every 7th row (Sheet2) copied and pasted to the next row in Sheet1? or do do you want each row (Sheet2) copied and pasted to every 7th row in Sheet

I want each row in the sheet 2 copied and paste to every 7th row in sheet 1. and everytime there is new list on sheet2, I need it to be copied and paste below the previous ID list on sheet 1.

 

[youngbella]

If im understanding maybe this:

Set sh1 = ThisWorkbook.Worksheets("June")
Set sh2 = ThisWorkbook.Worksheets("ImportData")
finalrow = sh2.Cells(sh2.Rows.Count, "D").End(xlUp).Row

If finalrow > 13 Then
    For i = 14 To finalrow Step 7
        sh1.Cells(i - 3, "A").Value = sh2.Cells(i, "D").Value
    Next i
End If

hi sir, thank you for your help but I already manage to get the exact code that I want. but the only problem is when I want to paste new list (as the list is updated), it replaced my previous copied list in the sheet 1. I want it to be paste after the previous data. Ive used the end(xlup) but it didnt work.

ub copypasteskip()

    Dim sheet1 As Worksheet
    Dim sheet2 As Worksheet
    Dim finalrow As Long
    Dim i As Long
    Dim r As Long


    Set sheet1 = ThisWorkbook.Worksheets("June")
    Set sheet2 = ThisWorkbook.Worksheets("ImportData")

    finalrow = sheet2.Cells(Rows.Count, "D").End(xlUp).Row
    
    
    r = sheet1.Range("A:A").End(xlUp).Row
    
    
    r = 11
        
    For i = 14 To finalrow
        
 
        sheet2.Cells(i, "D").Copy
        sheet1.Cells(r, "A").End(xlup).PasteSpecial xlPasteValues
        
          
        r = r + 8
    Next i
        
      

End Sub