Trouble with a macro - copying cells

[ToddG]

Having trouble coming up with a macro to do the following:

If any cell in column A of sheet "Export" = "PKG",
Copy the cells in columns A, B, & L in that row to cells
A, C, & F of sheet "Labor Costing" respectively, starting
at Row 24 (of sheet "Labor Costing").

Kind of hard to explain, if you need more info let me know.

Any help would be appreciated,

TIA,
Todd

 

[Frank Kabel]

Hi
as a starting point:
http://www.rondebruin.nl/copy5.htm

 

[Bob Phillips]

Not tested, but try this

Set oCell = Columns("A:A").Find("PKG")
If Not oCell Is Nothing Then
Range("A" & oCell.Row).Copy Worksheets("Labor Costing").Range("A24")
Range("B" & oCell.Row).Copy Worksheets("Labor Costing").Range("C24")
Range("L & oCell.Row).Copy Worksheets("Labor Costing").Range("F24")
End If

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Bob Phillips]

Slight type

Set oCell = Columns("A:A").Find("PKG")
If Not oCell Is Nothing Then
Range("A" & oCell.Row).Copy Worksheets("Labor
Costing").Range("A24")
Range("B" & oCell.Row).Copy Worksheets("Labor
Costing").Range("C24")
Range("L" & oCell.Row).Copy Worksheets("Labor
Costing").Range("F24")
End If


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[ToddG]

Hi Bob,

Thanks for your reply. This code works except that it only
works for the first row that it finds "PKG". I need it to
look at ALL rows for "PKG" in column M and then run your
code for each row that it finds "PKG".

Thanks again

 

[ToddG]

Thanks very much for the link Frank...Great page. I'll
take a look at it.

Thanks again,
Todd

 

[Bob Phillips]

Dim iRow As Long

Sub CopyData()
Dim oCell As Range, sFirst

iRow = 24
With Columns("A:A")
Set oCell = .Find("PKG")
If Not oCell Is Nothing Then
sFirst = oCell.Address
Do
CopyCells oCell
Set oCell = .FindNext(oCell)
Loop While Not oCell Is Nothing And _
oCell.Address <> sFirst
End If
End With

End Sub

Sub CopyCells(rng As Range)

Range("A" & rng.Row).Copy _
Worksheets("Labor Costing").Range("A" & iRow)
Range("B" & rng.Row).Copy _
Worksheets("Labor Costing").Range("C" & iRow)
Range("L" & rng.Row).Copy _
Worksheets("Labor Costing").Range("F" & iRow)

iRow = iRow + 1

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)