Make one Input Form enter into two different locations?

[lucky12341]

Hi guys, I am using a "New Part" form I made via VBA and Macro's to enter data into a spreadsheet so the employees dont have to dig through them. I would like this form to enter all the same data into a second sheet as well. So basically when someone clicks the accept button I want it to enter the data into both the "Purchased" and into the "Used" form, in both cases into the next available empty row. The code I am am using is listed below. I have never had to target more then one spreadsheet so this is new. Thanks everyone in advance.
Private Sub Label1_Click()

End Sub

Private Sub Accept_Click()

ActiveWorkbook.Sheets("Purchased").Activate

Range("A1").Select

Do

If IsEmpty(ActiveCell) = False Then

ActiveCell.Offset(1, 0).Select

End If

Loop Until IsEmpty(ActiveCell) = True

ActiveCell.Value = PObox.Value

ActiveCell.Offset(0, 1) = PCMKbox.Value

ActiveCell.Offset(0, 2) = Partbox.Value

ActiveCell.Offset(0, 3) = Descriptionbox.Value

ActiveCell.Offset(0, 4) = Materialbox.Value

ActiveCell.Offset(0, 5) = Drawingbox.Value

ActiveCell.Offset(0, 6) = Qtybox.Value

ActiveCell.Offset(0, 7) = HICbox.Value


End Sub

Private Sub Cancel_Click()

Unload Me

End Sub

Private Sub Clear_Click()

Call UserForm_Initialize

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()

PObox.Value = ""

PCMKbox.Value = ""

Partbox.Value = ""

Descriptionbox.Value = ""

Materialbox.Value = ""

Drawingbox.Value = ""

Qtybox.Value = ""

HICbox.Value = ""


End Sub

 

[Norie]

Does this, untested, code work?

Private Sub Accept_Click()
Dim rng As Range
Dim NextRow As Long
Dim I As Long
Dim arrCtrls

    arrCtrls = Array("PObox", "PCNKbox", "Partbox", "Descriptionbox", "Materialbox", "Drawingbox", "Qtybox", "HICbox")
    
    NextRow = Sheets("Purchased").Range("A65536").End(xlUp).Row + 1
    
    Set rng = Sheets("Purchased").Range("A" & I)
    
    For I = LBound(arrCtrls) To UBound(arrCtrls)
        rng.Offset(0, I) = Me.Controls(arrCtrls(I)).Value
    Next I
    
    rng.EntireRow.Copy Sheets("Used").Range("A" & lastrow)

End Sub

 

[lucky12341]

I get an error code on this line

Set rng = Sheets("Purchased").Range("A" & I)

The entire code is this now...

Private Sub Accept_Click()

Dim rng As Range

Dim NextRow As Long

Dim I As Long

Dim arrCtrls

arrCtrls = Array("PObox", "PCNKbox", "Partbox", "Descriptionbox", "Materialbox", "Drawingbox", "Qtybox", "HICbox")

NextRow = Sheets("Purchased").Range("A65536").End(xlUp).Row + 1

Set rng = Sheets("Purchased").Range("A" & I)

For I = LBound(arrCtrls) To UBound(arrCtrls)
rng.Offset(0, I) = Me.Controls(arrCtrls(I)).Value
Next I

rng.EntireRow.Copy Sheets("Used").Range("A" & lastrow)

End Sub

 

[Norie]

Whoops!

That's not the only typo.

Private Sub Accept_Click()
Dim rng As Range
Dim NextRow As Long
Dim I As Long
Dim arrCtrls
    
    arrCtrls = Array("PObox", "PCNKbox", "Partbox", "Descriptionbox", "Materialbox", "Drawingbox", "Qtybox", "HICbox")
    
    NextRow = Sheets("Purchased").Range("A65536").End(xlUp).Row + 1
    
    Set rng = Sheets("Purchased").Range("A" & NextRow)
    
    For I = LBound(arrCtrls) To UBound(arrCtrls)
       rng.Offset(0, I) = Me.Controls(arrCtrls(I)).Value
    Next I
    
    rng.EntireRow.Copy Sheets("Used").Range("A" & NextRow)

End Sub