VBA - Increment range and loop until blank Cell

[Nordicrx8]

Hey all!

Need some help making an adjustment to my code. It works perfectly, but I need automate it.

Data is stored in the "Input" sheet, starting in cell B2. (B2:AH)

Once the rest of the code finishes, I need it to perform the same action, but move to the next row (B3:AH) Then automatically stop when there are no more entries on the input tab.

Currently there are ~500 rows on the input tab, but this number can vary.

I tried a few ways and failed - any help would be greatly appreciated!

Thank you!

Sub Combined()

Application.ScreenUpdating = False

    Sheets("Input").Select
    Range("B2:AH2").Select
    Selection.Copy
    Sheets("Main").Select
    Range("D8").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    
    Range("D21:Z26").Copy

    Sheets("Output").Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlValues
Selection.Value = Selection.Value

Application.ScreenUpdating = True
Excel.Application.CutCopyMode = False
Sheets("Main").Select

End Sub

 

[dreid1011]

What are you doing with this line:

Selection.Value = Selection.Value

Are you only looping through the input sheet? Does each loop overwrite row 8 in the Main sheet?

See if this does what you want, try it on a copy of your workbook as a standard module:

Private Sub InputOutput()
Dim lRow As Long, i As Long
Dim wsIn As Worksheet, wsOut As Worksheet, wsM As Worksheet
Set wsIn = Sheets("Input")
Set wsOut = Sheets("Output")
Set wsM = Sheets("Main")

lRow = wsIn.Range("B" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For i = 2 To lRow
    wsIn.Range("B" & i & ":AH" & i).Copy
    wsM.Range("D8").PasteSpecial xlPasteValues
    wsM.Range("D21:Z26").Copy
    wsOut.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
Next i
Application.ScreenUpdating = True
wsM.Select
End Sub

 

[Nordicrx8]

What are you doing with this line:

Selection.Value = Selection.Value

Are you only looping through the input sheet? Does each loop overwrite row 8 in the Main sheet?

See if this does what you want, try it on a copy of your workbook as a standard module:

Private Sub InputOutput()
Dim lRow As Long, i As Long
Dim wsIn As Worksheet, wsOut As Worksheet, wsM As Worksheet
Set wsIn = Sheets("Input")
Set wsOut = Sheets("Output")
Set wsM = Sheets("Main")

lRow = wsIn.Range("B" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For i = 2 To lRow
    wsIn.Range("B" & i & ":AH" & i).Copy
    wsM.Range("D8").PasteSpecial xlPasteValues
    wsM.Range("D21:Z26").Copy
    wsOut.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
Next i
Application.ScreenUpdating = True
wsM.Select
End Sub

That worked perfectly - thank you so much! I'm following what you did here, and this was definitely a much more elegant solution. THANK YOU!!

 

[dreid1011]

You're welcome, and happy to help.