Can you help me to loop my code to the next row?

[Nikijune]

Good afternoon,

I have built some code that I have applied to a command button, which copies and pastes data from one sheet to the next, but only If cell c7 is populated.

I am struggling to work out how to loop this code to the next row, and the next row and the next etc.

I only want to loop it from A7:M7 to A25:M25

Currently I have the below code and I have replicated it for each row that I want to apply it to, which looks quite messy, so I wanted to try and tidy it up a bit.

Any ideas?

Thanks

Public Sub Copy_Dailys()
'
'' CopyDailys Macro

    'Turns off screen updating
    Application.ScreenUpdating = False

    If ThisWorkbook.Sheets("Input").Range("C7").Text <> "" Then

    Sheets("Input").Select
    Range("A7,C7,E7,G7,I7,K7,M7").Select
    Range("M7").Activate
    Selection.Copy
    Sheets("Output").Select
    Range("A2").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Input").Select
    Range("A10").Select
    Application.CutCopyMode = False
    Range("A35").Select
    End If

 

[RCBricker]

Good afternoon,

I have built some code that I have applied to a command button, which copies and pastes data from one sheet to the next, but only If cell c7 is populated.

I am struggling to work out how to loop this code to the next row, and the next row and the next etc.

I only want to loop it from A7:M7 to A25:M25

Currently I have the below code and I have replicated it for each row that I want to apply it to, which looks quite messy, so I wanted to try and tidy it up a bit.

Any ideas?

Thanks

Public Sub Copy_Dailys()
'
'' CopyDailys Macro

    'Turns off screen updating
    Application.ScreenUpdating = False

    If ThisWorkbook.Sheets("Input").Range("C7").Text <> "" Then

    Sheets("Input").Select
    Range("A7,C7,E7,G7,I7,K7,M7").Select
    Range("M7").Activate
    Selection.Copy
    Sheets("Output").Select
    Range("A2").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Input").Select
    Range("A10").Select
    Application.CutCopyMode = False
    Range("A35").Select
    End If

a few questions

do you only want to copy cells A7, C7, E7,G7,I7,K7 and M7 if Cell C7 has value? do you want to check each of those cells for value or only the Column?

Do you to check all cells in columns C? or as your code suggest only certain rows?

 

[Nikijune]

Hello,

So my code how it is now works exactly as I want it to for that row. I want to replicate it, but for row 8 onwards.

So yes, I will always check column C, if column C is populated, then I will copy A, C, E, G, I, K and M

Below is a bit more of my code, which I have replicated for each row, up until row 25

Public Sub Copy_Dailys()
'
'' CopyDailys Macro

    'Turns off screen updating
    Application.ScreenUpdating = False
    If ThisWorkbook.Sheets("Input").Range("C7").Text <> "" Then

    Sheets("Input").Select
    Range("A7,C7,E7,G7,I7,K7,M7").Select
    Range("M7").Activate
    Selection.Copy
    Sheets("Output").Select
    Range("A2").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Input").Select
    Range("A10").Select
    Application.CutCopyMode = False
    Range("A35").Select
    End If
    If ThisWorkbook.Sheets("Input").Range("C8").Text <> "" Then

    Sheets("Input").Select
    Range("A8,C8,E8,G8,I8,K8,M8").Select
    Range("M8").Activate
    Selection.Copy
    Sheets("Output").Select
    Range("A2").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Input").Select
    Range("A10").Select
    Application.CutCopyMode = False
    Range("A35").Select
    
    End If
    
      If ThisWorkbook.Sheets("Input").Range("C9").Text <> "" Then

    Sheets("Input").Select
    Range("A9,C9,E9,G9,I9,K9,M9").Select
    Range("M9").Activate
    Selection.Copy
    Sheets("Output").Select
    Range("A2").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Input").Select
    Range("A10").Select
    Application.CutCopyMode = False
    Range("A35").Select
End If

 

[RCBricker]

I assumed you wanted to copy the cells in those columns AND that you wanted to check all the cells in column C.

try this

Public Sub Copy_Dailys()
Dim wsIN As Worksheet, wsOUT As Worksheet
Dim wb As Workbook
Dim lngROW As Long, lngRANGE As Long
Dim cell As Integer
'
'' CopyDailys Macro

    Set wb = ThisWorkbook
    Set wsIN = wb.Sheets("Input")
    Set wsOUT = wb.Sheets("Output")
    lngRANGE = wsIN.Range("C" & wsIN.Rows.Count).End(xlUp).Row
'Turns off screen updating
    Application.ScreenUpdating = False
    For cell = 7 To lngRANGE
        Sheets("Input").Select
        With Sheets("Input")
            If Range("C" & cell).Value <> "" Then
                Range("A" & cell & "," & "C" & cell & "," & "E" & cell & "," _
                    & "G" & cell & "," & "I" & cell & "," & "K" & cell & "," _
                    & "M" & cell).Copy
                Sheets("Output").Select
                With Sheets("Output")
                    lngROW = .Range("A" & .Rows.Count).End(xlUp).Offset(1).Row
                    Range("A" & lngROW).PasteSpecial xlPasteValues
                End With
                Application.CutCopyMode = False
            End If
        End With
    Next
End Sub

 

[Nikijune]

Thanks - this is great.

It is copying the whole data range over, but it is throwing up an error;

Run-time error '1004'

Cannot change part of a merged cell.

Like I say, the data is now in my 'output' sheet, I just don't want this error to come up

I don't have any merged cells in me input or output sheets!??

Thanks, Niki

 

[RCBricker]

Thanks - this is great.

It is copying the whole data range over, but it is throwing up an error;

Run-time error '1004'

Cannot change part of a merged cell.

Like I say, the data is now in my 'output' sheet, I just don't want this error to come up

I don't have any merged cells in me input or output sheets!??

Thanks, Niki

This error only throws if there is a merged cell. It is possible that you have one and forgot or didn't realize. try highlighting all cells and right-clicking - clicking format cells - select the alignment tab....and see if the merge cells box has a check in it. If so uncheck that box.

 

[Nikijune]

I did have merged cells...so that works fine now - apologies

One more thing though (sorry!)

I have data below, which this macro is also copying over. Can I get it to stop at row 25?

Thanks - Niki

 

[RCBricker]

I did have merged cells...so that works fine now - apologies

One more thing though (sorry!)

I have data below, which this macro is also copying over. Can I get it to stop at row 25?

Thanks - Niki

we can do that, but what is the logic that shows that it stops at 25?

The idea here is that you KNOW it needs to stop at 25 so we want to teach the code to KNOW it needs to stop at 25. That way if you make changes and need it to stop at 32 or 20 the code does not need to be changed cause it will KNOW that it now needs to stop at the new row.

 

[Nikijune]

Would it work if I put something in cell C26?

Like "stop here"??

 

[RCBricker]

Would it work if I put something in cell C26?

Like "stop here"??

you could do that and I can have the code look for that. However, that is a workaround and not a solution. Is the data below row 25 in row 26 or do you have a blank row the separates the two areas?