Help with a VBA macro ending with a LOOP

Hi Guys

I have a macro created and it starts on the cell which the user specifies and ends on the cell below. Is there a way in which i can have it looped until the end cell is empty?

Many Thanks

Shil



--------------------------------

Sub moverec()
'
' moverec Macro
'
' Keyboard Shortcut: Ctrl+m
'
    ActiveCell.Offset(0, 36).Range("A1:BE1").Select
    Selection.Copy
    Sheets("Bank File").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(-1, 0).Range("A1:D1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveSheet.Paste
    Sheets("Payroll Calculatios").Select
    ActiveCell.Offset(1, -36).Range("A1").Select
End Sub

Select a cell and click the button.

See if this is what you are after?

So here is my current macro code:

Sub moverec()
'
' moverec Macro
'
' Keyboard Shortcut: Ctrl+m
'
    ActiveCell.Offset(0, 47).Range("A1:BE1").Select
    Selection.Copy
    Sheets("Bank File").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(-1, 0).Range("A1:D1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveSheet.Paste
    Sheets("Payroll Calculatios").Select
    ActiveCell.Offset(1, -47).Range("A1").Select
End Sub

After looking online i think i found the code for the loop:

Sub Test2()

      ' Select cell A2, *first line of data*.
      Range("A2").Select
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here.
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop
   End Sub

The only part where im struggling is how to edit the current code so it includes this second code i found online.

I hope someone knows the answer.

Thanks

Shil

No it does not. It copies down from the row you select. If you select range("AV5") it will copy all rows from there to the last row in "AV5" into sheet "Bank File".

Or perhaps you are not explaining yourself correctly. Or I am not understanding you correctly?
My code copies all the values from Range("AV5:CZ5") to Range("AV22:CZ22") into "Bank File". If you want different data copied you are going to need to specify it.

You should only need be in AV5.
And of coarse it will replicate that row, b/c your file has the same data in the following rows until the empty one. Can you not see what is happening? It copies row 5 from column AV, then row 6 , row 7. Your data is exactly the same in these rows. If you don't what the same data, you need to specufy where you what it copied. Or you need to change the data.

Try this:

Sub dave()

    Dim wsBank           As Worksheet
    Dim wsData           As Worksheet
    Dim lngLastRow       As Long
    Dim lngOutRow        As Long
    Dim lngRow           As Long

    Set wsData = ActiveSheet
    Set wsBank = Sheets("Bank File")
    With wsBank

        lngOutRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    Application.ScreenUpdating = False

    ' get last row in col AV
    lngLastRow = Cells(Rows.Count, "AV").End(xlUp).Row

    For lngRow = ActiveCell.Row To lngLastRow
        wsBank.Cells(lngOutRow, 1).Resize(, 58).Value = Cells(lngRow, "AV").Resize(, 58).Value
        lngOutRow = lngOutRow + 1
    Next lngRow
    Application.ScreenUpdating = True
End Sub

Thanks Romperstomper, I completely missed that.

@5h1l , sorry about that, my code was not doing what I said it would.

It should have been this on this line.

         ws.Cells(lr, 1).Resize(, 58).Value = x.Resize(, 58).Value

Hi Guys, im wondering if i havent explained myself enough:

Here is the code:

ActiveCell.Offset(0, 47).Range("A1:BE1").Select
    Selection.Copy
    Sheets("Bank File").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(-1, 0).Range("A1:D1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveSheet.Paste
    Sheets("Payroll Calculatios").Select
    ActiveCell.Offset(1, -47).Range("A1").Select

This code is copying and pasting a particular row (Code in Red) and pastes to a different worksheet.

Then it returns in the cell below the last copied cell.

What i need to do is to somehow write a loop like the below which will keep on copying and pasting the rows to the other worksheet until it comes to an empty cell:

Sub Test2()

      ' Select cell A2, *first line of data*.
      Range("A2").Select
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here.
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop
   End Sub

Does anyone know how to combine the two codes, or to edit my code so that it keeps on looping until it finds an empty cell?

Help will be greatly appreciated.

Thanks

Shil

Without knowing the activecell at the start, it's impossible to rewrite that code. Based on your comment about my last code, I think perhaps:

Sub dave()

    Dim wsBank           As Worksheet
    Dim wsData           As Worksheet
    Dim lngLastRow       As Long
    Dim lngOutRow        As Long
    Dim lngRow           As Long

    Set wsData = ActiveSheet
    Set wsBank = Sheets("Bank File")
    With wsBank

        lngOutRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    Application.ScreenUpdating = False

    ' get last row in col AV
    lngLastRow = Cells(Rows.Count, "AV").End(xlUp).Row

    For lngRow = ActiveCell.Row To lngLastRow
        wsBank.Cells(lngOutRow, 1).Resize(, 58).Value = Cells(2, "AV").Resize(, 58).Value
        wsBank.Cells(lngOutRow + 1, 1).Resize(, 58).Value = Cells(lngRow, "AV").Resize(, 58).Value
        lngOutRow = lngOutRow + 2
    Next lngRow
    Application.ScreenUpdating = True
End Sub

If not, please post before and after samples so we can see what the output should be exactly.

Hi Romper Stomper, the active cell always starts in cell A5, then when it returns its in A6. Then i would execute the macro again so that it returns to A7. etc etc. Until it gets to the first blank cell, at which point i would move on to the next step.

Does this help?

Thanks

Shil

Please comment on the last code.