Hi Howard,

Am Fri, 30 Aug 2013 01:58:35 -0700 (PDT) schrieb Howard:

Smooth as silk!

instead of writing in the 4 cells you can write it in an array and write
back in a range:

Dim lRow As Long
Dim rngC As Range
Dim bRng As Range
Dim c As Range
Dim myArr As Variant
Dim varOut() As Variant
Dim i As Integer

lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set bRng = Range("B14:B" & lRow)
myArr = Array(1, 2, 4, 6) 'Column numbers

For Each c In bRng
If c.Value < "" Then
Set rngC = Worksheets("Invoice Data"). _
Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
For i = LBound(myArr) To UBound(myArr)
ReDim Preserve varOut(i)
varOut(i) = Cells(c.Row, myArr(i))
Next
rngC.Resize(, 4) = varOut
End If
Next


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2