gav meredith,
Hope this is what you want

Private Sub CommandButton3_Click()
'what is this copydata it is not working for me
'copydata Range("D9:D13"), "FEEDER"
'copydata Range("D16:D58"), "MACHINE"
'copydata Range("D63:D73"), "DELIVERY"
'copydata Range("D78:D82"), "PECOM"
'copydata Range("D88:D94"), "ROLLERS"
'copydata Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim col As String
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
'Debug.Print Sh.Range("A10").Resize(nrow * 1, 1).EntireRow _
..Address(external:=True)
' **to insert lines to accommodate new data _
activate the line below by removing " ' "**
'Sh.Range("A10").Resize(nrow * 1).EntireRow.Insert
' ** the line below will clear earlier data **
'Sh.Range("A10:G99").ClearContents
rw = 10
For Each cell In Range("D9:D98")
If Cells(cell.row, "C").Interior.ColorIndex = 3 Then
col = "G"
Else
col = "F"
End If
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.row, 4).Copy
Sh.Cells(rw, col).PasteSpecial Paste:=xlPasteValues
' **above four lines can be replaced with these lines**
'Cells(cell.row, 1).Copy Sh.Cells(rw, "A")
'Cells(cell.row, 4).Copy Sh.Cells(rw, col)
' **If you don't have formulas in Column A & D**
rw = rw + 1
End If
End If
End If
Next
End Sub

HTH
Cecil