VBA, copy cell range to sheet based on dropdown

[jsmith2094]

HI,

I have a sheet where I can add content to cells A2:D2

In cell B2 I have a drop down data validation list with options: Offline , Online , calls. these options also have a sheet named the same

I want to be able to copy range A2:D2 to the sheet that the user selects on B2 dropdown

any ideas?

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Make a selection in B2.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
    Range("A2:D2").Copy Sheets(Target.Value).Cells(Sheets(Target.Value).Rows.Count, "A").End(xlUp).Offset(1)
End Sub

 

[jsmith2094]

HI Thanks @mumps

that works great

the only problem I have is that every cell needs to be filled in and if I fill in 1 cell and choose the drop down it still copies to that sheet

is there a way to require all cells from A1:D1 to be filled in before it copies to the sheet and provide a msgbox ?

 

[mumps]

I'm a little confused. Is the drop down list only in cell B2 or is it in multiple cells in column B?

 

[jsmith2094]

@mumps , see the image I have attached , the first 3 cells are free type and the last is the dropdown box. I need it so the first 3 cells need to have been filled in before it copies it to the selected sheet from the dropdown

the cells in the image are B6, E6

Thanks,

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("E6")) Is Nothing Then Exit Sub
    If WorksheetFunction.CountA(Range("B6:D6")) <> 3 Then
        Application.EnableEvents = False
        Target.ClearContents
        MsgBox ("Please enter data in cells B6, C6 and D6.")
        Application.EnableEvents = True
        Exit Sub
    End If
    Range("A6:E6").Copy Sheets(Target.Value).Cells(Sheets(Target.Value).Rows.Count, "A").End(xlUp).Offset(1)
    Application.EnableEvents = True
End Sub

 

[jsmith2094]

@mumps , I tried your code but when I make a selection from the dropdown and leave the rest of the cells blank it still copies the data to the sheet and no msg box appears

 

[mumps]

I tested the macro on a dummy file and it worked properly. This line of code checks to see if B6, C6 and D6 contain data.

If WorksheetFunction.CountA(Range("B6:D6")) <> 3 Then

If any of these cells is empty, the message pops up and the macro is exited to prevent this line of code from executing:

Range("A6:E6").Copy Sheets(Target.Value).Cells(Sheets(Target.Value).Rows.Count, "A").End(xlUp).Offset(1)

 

[jsmith2094]

@mumps , sorry my bad forgot to reset the VBA editor , all working perfect, thank you so much.

Your a genius !

 

[mumps]

You are very welcome.