VBA Code to select specific cells and copy/paste them based on a drop down box

[Magoo9981]

Good evening everyone,

I have what I hope is a simple question but I am new enough with VBA that I have spent the last 5 hours trying to figure out how to do this and I am pulling what little hair out I have left.

Here is the layout:
Sheet 1 Everyone
Sheet 2 Option A
Sheet 3 Option B
Sheet 4 Option C
Sheet 5 Option D

Sheet 1 contains 4 Columns of Information
Column B - Name
Column D - City
Column F - County
Column H - Drop Down Box with Option A, B,C, and D

What I want to do is to keep the information on Sheet 1, and when I run a Macro it will "sort" Sheet 1 based on Option A, Option B, Option C, and Option D and move the Data from Column B, D, and F to the correct Option Sheet and paste it in Cells B,C, and D respectively from Sheet 1 without overwriting any previous information that is already in the Option Sheets

I hope this info is helpful. I haven't started writing the Macro as I have been having problems in researching how to set it up correctly. I want to be able to control when the Macro is activated by a button. I know how to do that, just not the code to get this to do what I want.

thanks in advance for your help on this.

Magoo

 

[sofas]

Sub SortAndMoveData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long, targetRow As Long
    Dim i As Long
    Dim optionValue As String
    
    Set wsSource = ThisWorkbook.Sheets("Everyone")
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    For i = 2 To lastRow
        optionValue = wsSource.Cells(i, 8).Value
        
        If optionValue <> "" Then
            On Error Resume Next
            Set wsTarget = ThisWorkbook.Sheets("Option " & optionValue)
            On Error GoTo 0
            
            If Not wsTarget Is Nothing Then
                targetRow = wsTarget.Cells(wsTarget.Rows.Count, "B").End(xlUp).Row + 1
                wsTarget.Cells(targetRow, 2).Value = wsSource.Cells(i, 2).Value
                wsTarget.Cells(targetRow, 3).Value = wsSource.Cells(i, 4).Value
                wsTarget.Cells(targetRow, 4).Value = wsSource.Cells(i, 6).Value
            End If
        End If
    Next i
    
    Set wsSource = Nothing
    Set wsTarget = Nothing
    
End Sub

 

[Magoo9981]

Ok, so this looks awesome and I appreciate it, however, I over simplified. the sheets have 4 independent names that are not Option A-D, due to my work, I have to be careful what I post online. Lets say the Sheet names are Alpha, Beta, Charlie, and Echo The drop down list is also Alpha Bravo, Charlie, and Echo in the H Column Drop Down List. I still need to copy B,D, and F from the Everyone sheet and deposit the information in B,C, and D respectively. I hope this makes sense.

 

[sofas]

Try this, is this what you mean?

Sub SortAndMoveData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long, targetRow As Long
    Dim i As Long
    Dim optionValue As String
    
    Set wsSource = ThisWorkbook.Sheets("Everyone")
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    For i = 2 To lastRow
        optionValue = wsSource.Cells(i, 8).Value
        
        If optionValue = "Alpha" Or optionValue = "Beta" Or optionValue = "Charlie" Or optionValue = "Echo" Then
            On Error Resume Next
            Set wsTarget = ThisWorkbook.Sheets(optionValue)
            On Error GoTo 0
            
            If Not wsTarget Is Nothing Then
                targetRow = wsTarget.Cells(wsTarget.Rows.Count, "B").End(xlUp).Row + 1
                wsTarget.Cells(targetRow, 2).Value = wsSource.Cells(i, 2).Value
                wsTarget.Cells(targetRow, 3).Value = wsSource.Cells(i, 4).Value
                wsTarget.Cells(targetRow, 4).Value = wsSource.Cells(i, 6).Value
            End If
        End If
    Next i
    
    Set wsSource = Nothing
    Set wsTarget = Nothing
End Sub

 

[Magoo9981]

Try this, is this what you mean?

Sub SortAndMoveData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long, targetRow As Long
    Dim i As Long
    Dim optionValue As String
 
    Set wsSource = ThisWorkbook.Sheets("Everyone")
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
 
    For i = 2 To lastRow
        optionValue = wsSource.Cells(i, 8).Value
     
        If optionValue = "Alpha" Or optionValue = "Beta" Or optionValue = "Charlie" Or optionValue = "Echo" Then
            On Error Resume Next
            Set wsTarget = ThisWorkbook.Sheets(optionValue)
            On Error GoTo 0
         
            If Not wsTarget Is Nothing Then
                targetRow = wsTarget.Cells(wsTarget.Rows.Count, "B").End(xlUp).Row + 1
                wsTarget.Cells(targetRow, 2).Value = wsSource.Cells(i, 2).Value
                wsTarget.Cells(targetRow, 3).Value = wsSource.Cells(i, 4).Value
                wsTarget.Cells(targetRow, 4).Value = wsSource.Cells(i, 6).Value
            End If
        End If
    Next i
 
    Set wsSource = Nothing
    Set wsTarget = Nothing
End Sub

This worked perfectly. Thank you so much.

 

[Peter_SSs]

This worked perfectly. Thank you so much.

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.

 

[Magoo9981]

My apologies. I am visually impaired and honestly thought I hit the correct button. I do have an additional question however, would that need to be put into another thread?

 

[Peter_SSs]

I do have an additional question however, would that need to be put into another thread?

If it is closely related to the original question in this thread you can continue here, otherwise best to start a new thread.
If you start a new thread you can always add a link to this one if you think it would aid your helpers.