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

wranglinkids

New Member
Joined
Mar 13, 2019
Messages
3
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
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
.
Code:
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
 
Upvote 0
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?
 
Upvote 0
.
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.
 
Upvote 0
.
If you want to clear those cells after copying, use this macro :

Code:
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
 
Upvote 0
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
 
Upvote 0
.
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.

Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top