Trying to loop

[Diving_Dan]

Hi all,

I've got the below code that doesn't seem to loop. I click my command button and it only creates one new line in my overtime data sheet. What I'm looking for it to do is create a new line on the overtime data sheet for for every cell within the D5:D24 range, so 20 entries containing the same data.

Private Sub CommandButton1_Click()
   
        Dim iRow As Long
        Dim ws As Worksheet
        Dim z As Control
       
        Set ws = Worksheets("Overtime Data")

        iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
           
            Dim rng2 As Range, cell As Range
            Set rng2 = Range("D5:D24")
           
            For Each cell In rng2
           
            ws.Cells(iRow, 1).Value = ActiveSheet.Range("$M$2:$Q$2").Value
            ws.Cells(iRow, 2).Value = ActiveSheet.Range("$M$2:$Q$2").Value
            ws.Cells(iRow, 3).Value = ActiveSheet.Range("$M$2:$Q$2").Value
            ws.Cells(iRow, 4).Value = ActiveSheet.Range("R2").Value
            ws.Cells(iRow, 5).Value = ActiveSheet.Range("F2").Value
           
            Next cell

   
End Sub

I have then tried to add a few more lines to add to the new lines data that is offset from the D5:D24 range but I get an error. I'm really not sure where i'm going wrong.

Private Sub CommandButton1_Click()
    
        Dim iRow As Long
        Dim ws As Worksheet
        Dim z As Control
        
        Set ws = Worksheets("Overtime Data")

        iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            
            Dim rng2 As Range, cell As Range
            Set rng2 = Range("D5:D24")
            
            For Each cell In rng2
            
            ws.Cells(iRow, 1).Value = ActiveSheet.Range("$M$2:$Q$2").Value
            ws.Cells(iRow, 2).Value = ActiveSheet.Range("$M$2:$Q$2").Value
            ws.Cells(iRow, 3).Value = ActiveSheet.Range("$M$2:$Q$2").Value
            ws.Cells(iRow, 4).Value = ActiveSheet.Range("R2").Value
            ws.Cells(iRow, 5).Value = ActiveSheet.Range("F2").Value
            ws.Cells(iRow, 6).velue = ActiveSheet.cell.Offset(0, 3).Value
            ws.Cells(iRow, 7).velue = ActiveSheet.cell.Offset(0, 4).Value
            ws.Cells(iRow, 8).velue = ActiveSheet.cell.Offset(0, 5).Value
            ws.Cells(iRow, 9).velue = ActiveSheet.cell.Offset(0, 6).Value
            
            Next cell
 
End Sub

 

[Fluff]

You need to increment iRow, otherwise you are just overwriting the cells.
Add iRow=iRow+1 just before the Next cell line

 

[Diving_Dan]

Thanks Fluff, that works perfectly.

This code is now still causing me a problem. Not sure how to reference the original cell.

ws.Cells(iRow, 6).velue = ActiveSheet.cell.Offset(0, 3).Value
ws.Cells(iRow, 7).velue = ActiveSheet.cell.Offset(0, 4).Value
ws.Cells(iRow, 8).velue = ActiveSheet.cell.Offset(0, 5).Value
ws.Cells(iRow, 9).velue = ActiveSheet.cell.Offset(0, 6).Value

 

[Fluff]

Get rid of the ActiveCell. so you just have cell.Offset(0, 3).Value

 

[Diving_Dan]

I've just realised another mistake, Spelling. Oops.

Working perfectly now.

Thanks

 

[Fluff]

Glad to help & thanks for the feedback