Copy Rows to multiple sheets based on drop down validation Solved/Closed

Question

Hello all,

I have tried to find the answer to my query through other questions but can't put my finger on what to do. 

I would like to copy rows over to Sheet 2 based on data validation (drop-down List) in Column J when "Completed" is selected.

I am using the following Macro which seems to work however, i also want the row to copy over to Sheet 3, 4 OR 5 depending on Column E. So when Column J is "Completed", the row copies over to Sheet 2, and if J is "Ross" - copies over to Sheet 3 (and sheet2), J is "Martin" - copies over to sheet 4 and sheet 2, "Lauren" - copies over to Sheet 5 and 2 and "Clare" Sheet 6 and 2. 

May be worth noting that ColumnE (name) is also selected using a drop down list.

I currently have the following macro: 

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
If Intersect(Target, Columns("J:J")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

        If Target.Value = "Completed" Then
        Target.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
        Target.EntireRow.Delete
        End If
  
Sheet2.Columns.AutoFit

Application.CutCopyMode = False
Application.ScreenUpdating = True


End Sub. 



I ALSO HAVE:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
If Intersect(Target, Columns("E:E")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

        If Target.Value = "Ross" Then
        Target.EntireRow.Copy Sheet3.Range("A" & Rows.Count).End(3)(2)
        End If
  
Sheet2.Columns.AutoFit

Application.CutCopyMode = False
Application.ScreenUpdating = True

If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
If Intersect(Target, Columns("E:E")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

        If Target.Value = "Martin" Then
        Target.EntireRow.Copy Sheet4.Range("A" & Rows.Count).End(3)(2)
        End If
  
Sheet2.Columns.AutoFit

Application.CutCopyMode = False
Application.ScreenUpdating = True

If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
If Intersect(Target, Columns("E:E")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

        If Target.Value = "Lauren" Then
        Target.EntireRow.Copy Sheet5.Range("A" & Rows.Count).End(3)(2)
        End If
  
Sheet2.Columns.AutoFit

Application.CutCopyMode = False
Application.ScreenUpdating = True

If Target.Count > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
If Intersect(Target, Columns("E:E")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

        If Target.Value = "Clare" Then
        Target.EntireRow.Copy Sheet6.Range("A" & Rows.Count).End(3)(2)
        End If
  
Sheet2.Columns.AutoFit

Application.CutCopyMode = False
Application.ScreenUpdating = True




End Sub


BUT the drop down isn't copying over to Sheet 2 and therefore this macro isn't working. 

Any ideas on how to make this all one macro??

vcoolio · Answer

Hello Becky,

There appears to be some contradiction in your explanation:

-You mention Column J having a drop down selection in which if "Completed" is selected then the relevant row of data is transferred to sheet2.

- Then, your following explanation:
I am using the following Macro which seems to work however, i also want the row to copy over to Sheet 3, 4 OR 5 depending on Column E. So when Column J is "Completed", the row copies over to Sheet 2, and if J is "Ross" - copies over to Sheet 3 (and sheet2), J is "Martin" - copies over to sheet 4 and sheet 2, "Lauren" - copies over to Sheet 5 and 2 and "Clare" Sheet 6 and 2. 

suggests that the names are in Column J as well!

Are the names in Column J or Column E?
(The codes that you supplied suggest that the names are in Column E).
Is Column J supposed to just have criteria such as "Completed", "Pending".......etc.?

Could you please clarify your intent.

To save time for everyone involved, could you please upload a sample of your workbook to a free file sharing site such as WeTransfer or Drop Box showing inputs and expected outputs. Please ensure that your sample is an exact replica of your actual workbook and if your data is sensitive then please use dummy data.
This will certainly help us to help you quickly resolve your query.

Thank you Becky.

Cheerio,
vcoolio.

vcoolio · Answer

Hello Becky,

Just clarifying a little more:-

- Your input sheet is the "Pipeline" sheet with data starting in Row10?
- You only require the data from Columns A:U transferred to the "Completed" sheet and to the selected individual's sheet?
- There are a number of hidden/blank columns in the "Pipeline" sheet. Will they have any data in them to be transferred?

Cheerio,
vcoolio.

vcoolio · Answer

Hello Becky:-

Here you go:-

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
        
        If Target.Count > 1 Then Exit Sub
        If Target.Value = vbNullString Then Exit Sub

Application.ScreenUpdating = False

If Not Intersect(Target, Columns("J:J")) Is Nothing Then
                Set ws = Sheets(Target.Offset(, -5).Value & " " & "Completions")
                If Target.Value = "Completed" Then
                      Target.EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(3)(2)
                      Target.EntireRow.Copy ws.Range("A" & Rows.Count).End(3)(2)
                      Target.EntireRow.Delete
                      Sheet2.Columns.AutoFit
                      ws.Columns.AutoFit
                End If
        End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Just a couple of things to note:-
- In your workbook, you have event codes in two modules. Please remove them. They shouldn't be in a standard module.
- In both the "Pipeline" and "Completed" sheets you don't have a column for App Date whereas all the destination sheets do (Column M). Insert an App Date column in the same position in the "Pipeline" and "Completed" sheets (ensure that it is Column M). If you don't, the transferred data will come up one column short in the destination sheets.

To implement the above code:-
- Right click on the "Pipeline" sheet tab.
- Select "View Code" from the menu that appears.
- In the code field that then appears, your existing code should be there. Replace it with the new above code.

Please test the code in a copy of your actual workbook. 

I hope that this helps.

Cheerio,
vcoolio.

Copy Rows to multiple sheets based on drop down validation

3 responses

Similar discussions

Subscribe To Our Newsletter!