Copy a range instead of just one row but with condition

  • Thread starter Thread starter Cimjet
  • Start date Start date
C

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
 
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.
Click to expand...

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
 
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
 
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.
Click to expand...

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
 
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
 
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.
Click to expand...

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
 
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
 
Back
Top