copy rows
 

Hello
I have a few large matrix (16000*60) . and On sheet1,column H is numbered
1 to 16000 irregularly. i want to copy multiple rows entirly to sheet2, when
i select or input number of rows at column H to a box (4 example: 15
,350,12600,...) then, related rows copy to sheet2,all at once.
I need to a macro to do it.
Thank's for any help.

best regards

copy rows
 

Hi,

Try this. Right click Sheet1 sheet tab, view code and paste this in on the
right.
Enter the rows to copy (Numbers in column H) seperated by commas.

Sub Marine()
Dim arrParts() As String
Dim MyRange As Range, CopyRange As Range
Dim LastRow As Long
LastRow = Cells(Cells.Rows.Count, "H").End(xlUp).Row
Set MyRange = Range("H1:H" & LastRow)
response = InputBox("Enter rows to copy in the format nnn,nnn,nn")
arrParts = Split(response, ",")
For Each C In MyRange
For Each strPart In arrParts
If C.Value = Val(strPart) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
Next

If Not CopyRange Is Nothing Then
LastRow = Sheets("Sheet2").Cells(Cells.Rows.Count, "A").End(xlUp).Row
CopyRange.Copy Sheets("Sheet2").Range("A" & LastRow + 1)
End If
End Sub

Mike

"climate" wrote:

Hello
I have a few large matrix (16000*60) . and On sheet1,column H is numbered
1 to 16000 irregularly. i want to copy multiple rows entirly to sheet2, when
i select or input number of rows at column H to a box (4 example: 15
,350,12600,...) then, related rows copy to sheet2,all at once.
I need to a macro to do it.
Thank's for any help.

best regards

copy rows
 

Hi Mike
I am grateful for your kindness,the macro works properly.
best regards

"Mike H" wrote:

Hi,

Try this. Right click Sheet1 sheet tab, view code and paste this in on the
right.
Enter the rows to copy (Numbers in column H) seperated by commas.

Sub Marine()
Dim arrParts() As String
Dim MyRange As Range, CopyRange As Range
Dim LastRow As Long
LastRow = Cells(Cells.Rows.Count, "H").End(xlUp).Row
Set MyRange = Range("H1:H" & LastRow)
response = InputBox("Enter rows to copy in the format nnn,nnn,nn")
arrParts = Split(response, ",")
For Each C In MyRange
For Each strPart In arrParts
If C.Value = Val(strPart) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next
Next

If Not CopyRange Is Nothing Then
LastRow = Sheets("Sheet2").Cells(Cells.Rows.Count, "A").End(xlUp).Row
CopyRange.Copy Sheets("Sheet2").Range("A" & LastRow + 1)
End If
End Sub

Mike

"climate" wrote:

Hello
I have a few large matrix (16000*60) . and On sheet1,column H is numbered
1 to 16000 irregularly. i want to copy multiple rows entirly to sheet2, when
i select or input number of rows at column H to a box (4 example: 15
,350,12600,...) then, related rows copy to sheet2,all at once.
I need to a macro to do it.
Thank's for any help.

best regards