VBA Code

The following code assumes that you want to run through each row, starting at cell A1, until there is no data in column A.


Sub Copy_Row()
' Written by Barrie Davidson
Dim NRow As Long
Dim CurrentRow As Integer
Dim SheetName As String
Dim Datasheet As String

     Datasheet = ActiveSheet.Name
     ActiveWorkbook.Sheets.Add after:=Sheets(Datasheet)
     SheetName = ActiveSheet.Name
     Sheets(Datasheet).Select
     Range("A1").Select
     Do Until Selection.Value = ""
          CurrentRow = Selection.Row
          NRow = InputBox("Current row selected is " & CurrentRow & Chr(13) & _
               "Enter Number of Copies Required")
          Selection.EntireRow.Copy
          Sheets(SheetName).Select
          ActiveCell.Range("A1:A" & NRow).EntireRow.Select
          ActiveSheet.Paste
          Application.CutCopyMode = False
          ActiveCell.Range("A" & NRow).Offset(1, 0).Select
          Sheets(Datasheet).Select
          ActiveCell.Offset(1, 0).Select
     Loop
End Sub