ddh
09-13-2005, 11:46 AM
This code works when I put 1 in the InputBox but if I put 2 or 3 in it will stop at SRg = Range(Rg.Item(0), Rg.Item(i).Offset(0, 16)).Address.
Thank you for your help.
Sub PasteRowAX1T()
' PasteRowAX1 Macro
Application.ScreenUpdating = False
Dim Rg As Range
Dim SRg As String
Dim LRg As String
RowIns = InputBox("Enter number of rows required")
For i = 1 To RowIns
Set Rg = Selection
SRg = Range(Rg.Item(0), Rg.Item(i).Offset(0, 16)).Address
Range(SRg).Select
LRg = Range(Rg.Item(0).Offset(1, 16), Rg.Item(i).Offset(0, 16)).Address
Selection.Copy Destination:=Range(SRg & ":" & LRg)
Cells(ActiveCell.Row, 1).Resize(1, 17).Copy _
Destination:=Cells(ActiveCell.Row + 1, 1).Resize(RowIns, 1)
Next i
Cells(ActiveCell.Row + 2, 1).Select
Set Rg = Nothing
Application.ScreenUpdating = True
End Sub
Thank you for your help.
Sub PasteRowAX1T()
' PasteRowAX1 Macro
Application.ScreenUpdating = False
Dim Rg As Range
Dim SRg As String
Dim LRg As String
RowIns = InputBox("Enter number of rows required")
For i = 1 To RowIns
Set Rg = Selection
SRg = Range(Rg.Item(0), Rg.Item(i).Offset(0, 16)).Address
Range(SRg).Select
LRg = Range(Rg.Item(0).Offset(1, 16), Rg.Item(i).Offset(0, 16)).Address
Selection.Copy Destination:=Range(SRg & ":" & LRg)
Cells(ActiveCell.Row, 1).Resize(1, 17).Copy _
Destination:=Cells(ActiveCell.Row + 1, 1).Resize(RowIns, 1)
Next i
Cells(ActiveCell.Row + 2, 1).Select
Set Rg = Nothing
Application.ScreenUpdating = True
End Sub