VBA to copy rows to a master sheet when a quantity is entered in one of the material worksheets

[wranglinkids]

I have attached my file. I have tried several different codes, but to no avail. Upon entry of a quantity in worksheets Conduit, Strut, Wire & Misc., I need that row of information to be copied into the RFQ form in the respective columns. I have deleted all the codes that I have tried so I am starting with a clean slate.

Thank you for any help! https://1drv.ms/x/s!AlKFTo6xHS_vg9p1sS5gzVlRikyNag

 

[Logit]

.

Option Explicit


Sub test()


Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("RFQ")  'specify sheet name here to paste to
    x = 7   'begins pasting in Sheet RFQ on row 7
    Application.ScreenUpdating = 0
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                Rws = .Cells(Rows.Count, "C").End(xlUp).Row 'searches Col C all sheets
                Set Rng = .Range(.Cells(2, "C"), .Cells(Rws, "C"))
                For Each c In Rng.Cells
                    If c.Value <> "" Then  'searches for non-blank cells
                        c.EntireRow.Copy
                        ws.Range("A" & x).PasteSpecial Paste:=xlValues
                        x = x + 1
                    End If
                Next c
            End With
        End If
    Next sh
ws.Range("A1").Select


End Sub

 

[wranglinkids]

Thank you Logit! This is so close to working exactly as I need it to!!! Just a couple things, I pasted the code in the "ThisWorksheet", is that correct? How do I tweak the code so that when a quantity is entered, it copies to the RFQ page without going into the "View Code" and clicking on "run"? Also, is there a way that if a wrong quantity is entered and is then deleted, it will remove it from the RFQ form automatically?

 

[Logit]

.
The code should be pasted into a routine module.

To run the macro, paste a button on the RFQ sheet attached to the macro. You'll need to paste the macro first, then the button.

If an error is made entering data, the user will need to correct the error then click on the button again which will re-copy all the data
to the RFQ sheet again. Or easier, just edit the data on the RFQ sheet and be done with it.

We can add a few more lines to the macro that will clear all the entries on all sheets EXCEPT RFQ, after the button has been clicked.
That will prepare those sheets for future entries without duplicating data.

 

[Logit]

.
If you want to clear those cells after copying, use this macro :

Option Explicit


Sub test()


Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("RFQ")  'specify sheet name here to paste to
    x = 7   'begins pasting in Sheet RFQ on row 7
    Application.ScreenUpdating = 0
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                Rws = .Cells(Rows.Count, "C").End(xlUp).Row 'searches Col C all sheets
                Set Rng = .Range(.Cells(2, "C"), .Cells(Rws, "C"))
                For Each c In Rng.Cells
                    If c.Value <> "" Then  'searches for non-blank cells
                        c.EntireRow.Copy
                        ws.Range("A" & x).PasteSpecial Paste:=xlValues
[B][COLOR=#ff0000]                        c.Value = ""            '<<--------------------------- line added[/COLOR][/B]
                        x = x + 1
                        
        End If
                Next c
            End With
        End If
    Next sh
ws.Range("A1").Select


End Sub

 

[wranglinkids]

So I changed the A1 at the end to A2 as it was pulling the header row out of the sheets and copying them to the RFQ form and it stopped that, but now that I added the clear code - c.Value = "" now it is pulling the column headers into the RFQ form again....sorry to be such a pest!!

Option Explicit




Sub test()




Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
Set ws = Worksheets("RFQ") 'specify sheet name here to paste to
x = 7 'begins pasting in Sheet RFQ on row 7
Application.ScreenUpdating = 0
For Each sh In Sheets
If sh.Name <> ws.Name Then
With sh
Rws = .Cells(Rows.Count, "C").End(xlUp).Row 'searches Col C all sheets
Set Rng = .Range(.Cells(2, "C"), .Cells(Rws, "C"))
For Each c In Rng.Cells
If c.Value <> "" Then 'searches for non-blank cells
c.EntireRow.Copy
ws.Range("A" & x).PasteSpecial Paste:=xlValues
c.Value = ""
x = x + 1
End If
Next c
End With
End If
Next sh
ws.Range("A2").Select




End Sub

 

[Logit]

.
Yes ... I didn't see that at first. Here is a correction --- do not use the other macros.

Also, this version includes the additional macro to clear the RFQ sheet when you are done using it.
Paste a second button to the RFQ sheet attached to the clrRange sub.

Option Explicit


Sub test()


Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("RFQ")  'specify sheet name here to paste to
    x = 7   'begins pasting in Sheet RFQ on row 7
    Application.ScreenUpdating = 0
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                For Each c In .Range("C2:C500")     '<--- look at first 500 rows below row 1
                    If c.Value <> "" Then           'searches for non-blank cells
                        c.EntireRow.Copy
                        ws.Range("A" & x).PasteSpecial Paste:=xlValues
                        c.Value = ""                '<<--------------------------- line added
                        x = x + 1
        End If
                Next c
            End With
        End If
    Next sh
ws.Range("A1").Select


End Sub
' clears the RFQ sheet of all entries
Sub clrRange()
    Sheet1.Range("A7:F500").Value = ""
End Sub