Excel2000 vba macro

QuestionEdit

Hello and thank you for your help

I am writing a Quote system ehich requires a vba macro to copy data created in rows A,B,F,G,H,I,J,K from entry of a quantity in cell F in any of rows 4:51. Once entry is complete,I want to copy the data in each row where there has been a qty entered in col.F into 1st empty row in range 16:34 cols V,W,X,Y,Z,AA,AB,AC Thank you - I hope this is clear

AnswerEdit

Tony,

Are you asking how you would do that with a macro.

Sub copydata() Dim v As Variant, v1 As Variant Dim r As Range, r1 As Range, cell As Range Dim rw As Long, i As Long v = Array("A", "B", "F", "G", "H", "I", "J", "K") v1 = Array("V", "W", "X", "Y", "Z", "AA", "AB", "AC") Set r = Range("F4:F51") On Error Resume Next

 Set r1 = r.SpecialCells(xlConstants, xlNumbers)

On Error GoTo 0 rw = 16 Do While Len(Trim(Cells(rw, "V").Text)) > 0

 rw = rw + 1

Loop

If Not r1 Is Nothing Then

 For Each cell In r1
   For i = LBound(v) To UBound(v)
      Cells(cell.Row, v(i)).Copy
      With Cells(rw, v1(i))
          .PasteSpecial xlValues
          .PasteSpecial xlFormats
      End With
   Next
   rw = rw + 1
 Next

Else

 MsgBox "Nothing to do"

End If

End Sub

I didn't check to see if the data would go beyond row 34 since you didn't say what to do about that. If you want to be warned and then have the macro quit, you can do this:

Sub copydata() Dim v As Variant, v1 As Variant Dim r As Range, r1 As Range, cell As Range Dim rw As Long, i As Long, cnt As Long v = Array("A", "B", "F", "G", "H", "I", "J", "K") v1 = Array("V", "W", "X", "Y", "Z", "AA", "AB", "AC") Set r = Range("F4:F51") On Error Resume Next

 Set r1 = r.SpecialCells(xlConstants, xlNumbers)

On Error GoTo 0 rw = 16 Do While Len(Trim(Cells(rw, "V").Text)) > 0

 rw = rw + 1

Loop

If Not r1 Is Nothing Then

 cnt = r1.Count
 If cnt > 35 - rw Then
    MsgBox "Output would exceed row 34, quitting"
    Exit Sub
 End If
 For Each cell In r1
   For i = LBound(v) To UBound(v)
      Cells(cell.Row, v(i)).Copy
      With Cells(rw, v1(i))
          .PasteSpecial xlValues
          .PasteSpecial xlFormats
      End With
   Next
   rw = rw + 1
 Next

Else

 MsgBox "Nothing to do"

End If

End Sub

the macro was tested and worked for me as I interpreted your question. You should test it on a copy of your worksheet to insure it does what you expect.