Copy a range instead of just one row but with condition

[Cimjet]

Hi Everyone
The small macro below copies the information from row 20 on to an order form
sheet.
I need to have it check from row 20 to row 36 and copy it if column B starts
with a number.
Your help is always appreciated. Thank you
Sub Parts_Order()
With Sheets("Parts Order Form")
'QTY
lLastRow = .Cells(.Rows.Count, "a").End(xlUp).Row
.Cells(lLastRow + 1, "a").Value = _
Sheets("Invoice").Range("A20").Value
'Part Number
lLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
.Cells(lLastRow + 1, "B").Value = _
Sheets("Invoice").Range("b20").Value
End With
End Sub
Sub Parts_Order()
'Invoice Number
lLastRow = .Cells(.Rows.Count, "d").End(xlUp).Row
.Cells(lLastRow + 1, "d").Value = _
Sheets("Invoice").Range("K2").Value
'QTY
lLastRow = .Cells(.Rows.Count, "a").End(xlUp).Row
.Cells(lLastRow + 1, "a").Value = _
Sheets("Invoice").Range("A20").Value
'Part Number
lLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
.Cells(lLastRow + 1, "B").Value = _
Sheets("Invoice").Range("b20").Value
End With
End Sub
Regards
Cimjet

 

[Claus Busch]

Hi Cimjet,

Am Mon, 20 Jun 2011 11:25:41 -0400 schrieb Cimjet:

The small macro below copies the information from row 20 on to an order form
sheet.
I need to have it check from row 20 to row 36 and copy it if column B starts
with a number.

try this:
Sub Parts_Order()
Dim FRow As Long
Dim i As Integer
Dim Pos1 As String

With Sheets("Parts Order Form")
For i = 20 To 36
FRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Pos1 = Left(Sheets("Invoice").Cells(i, 2), 1)
If IsNumeric(Pos1) Then
Sheets("Invoice").Rows(i).Copy _
Destination:=.Range("A" & FRow)
End If
Next
End With

End Sub


Regards
Claus Busch

 

[Cimjet]

Hi Claus
Thank you very much. it works.
Can this be modified to copy the value only, now it's pasting the formulas and
one row "B" is a Data Validation box.
Regards
Cimjet

 

[Claus Busch]

Hi Cimjet,

Am Mon, 20 Jun 2011 12:27:51 -0400 schrieb Cimjet:

Can this be modified to copy the value only, now it's pasting the formulas and
one row "B" is a Data Validation box.

then change the if block to:
If IsNumeric(Pos1) Then
Sheets("Invoice").Rows(i).Copy
.Range("A" & FRow).PasteSpecial xlPasteValues
End If


Regards
Claus Busch

 

[Cimjet]

Hi Claus
That did it.
Thank you very much
Best regards
Cimjet

 

[Cimjet]

Hi Claus
I was to fast in my request yesterday, I was missing information.
Instead of the full Row, I need only column A,B and D.
I tried to change it but without success.
Your help would be very much appreciated.
Cimjet

 

[Claus Busch]

Hi,

Am Tue, 21 Jun 2011 08:16:48 -0400 schrieb Cimjet:

Instead of the full Row, I need only column A,B and D.
I tried to change it but without success.

try this:
Sub Parts_Order()
Dim FRow As Long
Dim i As Integer
Dim Pos1 As String
Dim myRange As Range

With Sheets("Parts Order Form")
For i = 20 To 36
FRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Pos1 = Left(Sheets("Invoice").Cells(i, 2), 1)
If IsNumeric(Pos1) Then
Set myRange = Application.Union(Sheets("Invoice"). _
Range("A" & i & ":B" & i), Sheets("Invoice") _
.Range("D" & i))
myRange.Copy
.Range("A" & FRow).PasteSpecial xlPasteValues
End If
Next
End With

End Sub



Regards
Claus Busch

 

[Claus Busch]

Hi Cimjet,

faster version:
Sub Parts_Order2()
Dim FRow As Long
Dim i As Integer
Dim Pos1 As String
Dim myRange As Range

Application.ScreenUpdating = False
With Sheets("Parts Order Form")
For i = 20 To 36
FRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Pos1 = Left(Sheets("Invoice").Cells(i, 2), 1)
If IsNumeric(Pos1) Then
.Cells(FRow, 1) = Sheets("Invoice").Cells(i, 1)
.Cells(FRow, 2) = Sheets("Invoice").Cells(i, 2)
.Cells(FRow, 3) = Sheets("Invoice").Cells(i, 4)
End If
Next
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus Busch

 

[Cimjet]

Hi Claus
Thank you very much, it works perfectly.
Have a great day
Cimjet