VBA to Copy cells to another sheet based on two values

[STEVEMILLS04]

Good day to all. I have the code below in my spreadsheet that works great as is, however, I need to make some adjustments and not sure how to do so.

First, I would like to make this a button rather than a Worksheet_Change event. How do I transition it to a Macro?
Second, when the code first runs, it should clear all information on rows 3 and on but only in particular tabs. I can manage and type the tab names, just need the basic template on how to program this.
Third, I would like the values of J AND D to drive when a row is copied. I currently just have J2:J. How do I change to code to include the values of D?
Finally, I would love if I could include multiple combinations. By this, I mean if J is Promotable and D is Community Mgr, copy row to the tab named Promotable CM. If J is Well Placed and D is Community Mgr, copy to tab named Well Placed CM. If J is Well Placed and D is Asst Community Mgr, copy to tab named Well Placed ACM. I think you get the idea. I can pre-create these tabs and do all the typing for the code, just need the template as I am not sure how to go about this.

Thank you SOOO MUCH for any help you can provide.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LR As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    If Flag = True Then Exit Sub
    If Not Intersect(Target, Range("J2:J" & LR)) Is Nothing Then
        If Target.Value = "Promotable" Then
            LR = Sheets("Test Promotable").Range("A" & Rows.Count).End(xlUp).Row + 1
            Target.EntireRow.Copy
            Sheets("Test Promotable").Range("A" & LR).PasteSpecial
            Flag = True
        End If
    End If
    Application.CutCopyMode = False
    Flag = False
End Sub

 

[ZAX]

First,to Change The Code Into a Normal Macro Change The Macro Name,Remove The "Private" Property And Remove Anything Between The Brackets Like The Following Code.
Second,This Macro Will Show an Inputbox To Select The Sheets -I Know This Isn't What You Want But I Don't Know What You Want From Issues "3-4"?

Sub Copy()
'Code Here..
i = InputBox("Type The Sheet Names Seperated With a Comma"",", "Copy Data")
If i = "" Then
   Exit Sub
End If
If InStr(1, i, ",") > 0 Then
   For l = 1 To Len(i)
       If Mid$(i, l, 1) = "," Then
          commas = commas + 1
       End If
   Next
   s = Split(i, ",")
   For sname = 0 To commas
       Sheets(s(sname)).Select
   Next
Else
   Sheets(i).Select
End If
'Code Here..
End Sub

ZAX

 

[STEVEMILLS04]

Zax, thanks for your help. For issue 3 and 4 they are kind of the same question, I want the code to copy the cells based on a short list of particular values for two columns, where my original code only had one column, which was J and it was only if the cell was equal to one value, where now I need it to be for several values. So, if J is Promotable and D is Community Manager, move to tab Promotable CM. I would want these hardcoded as there are only so many options. Again, if only two examples could be provided, I can copy and paste the code and manually edit. Another example would be if J is Well Placed and D is Community Manager, move to tab named Well Placed CM.

 

[ZAX]

I Hope This Code Will Help You.

Sub Copy()
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
For Each Cell In Range("D1:D" & LR)
    If Cell.Value = "Community Manager" Then
       If Cell.Offset(0, 6).Value = "Promotable" Then
          Cell.EntireRow.Copy
          Sheets("Promotble CM").Select
          Range("A" & LR + 1).PasteSpecial
          Application.CutCopyMode = False
       End If
    Else
       If Cell.Value = "Community Manager" Then
          If Cell.Offset(0, 6).Value = "Well Placed" Then
             Cell.EntireRow.Copy
             Sheets("Well Placed CM").Select
             Range("A" & LR + 1).PasteSpecial
             Application.CutCopyMode = False
          End If
       End If
    End If
Next
End Sub

ZAX

 

[STEVEMILLS04]

Zax, thank you. We are almost there. Just several issues.

1. The code is only copying one of the instances where the statements are true. For example, the sheet I ran this on has 2 community managers that are promotable and 1 cm that is well placed. It is only copying the 2 instance of the promotable cm and not copying the well placed cm at all.
2. It is copying/pasting the row to line 28 on the new tab. I even deleted and created new tabs and ran it several times, same problem. I made very slight adjustments to the code. The new code is below:

Sub Copy()
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
For Each Cell In Range("C1:C" & LR)
    If Cell.Value = "Community Mgr" Then
       If Cell.Offset(0, 7).Value = "Promotable" Then
          Cell.EntireRow.Copy
          Sheets("Test Promotable").Select
          Range("A" & LR + 1).PasteSpecial
          Application.CutCopyMode = False
       End If
    Else
       If Cell.Value = "Community Mgr" Then
          If Cell.Offset(0, 7).Value = "Well Placed" Then
             Cell.EntireRow.Copy
             Sheets("Test Well Placed").Select
             Range("A" & LR + 1).PasteSpecial
             Application.CutCopyMode = False
          End If
       End If
    End If
Next
End Sub

 

[ZAX]

Sorry To Waste Your Time...
This Code Works Like A Charm.

Sub Copy()
Dim LR As Long
LR = Cells(Rows.Count, 3).End(xlUp).Row
For Each Cell In Range("C1:C" & LR)
    If Cell.Value = "Community Manager" Then
       If Cell.Offset(0, 7).Value = "Promotable" Then
          Cell.EntireRow.Copy
          Sheets("Test Promotable").Select
          If Range("A1").Value = "" Then
             Range("A1").PasteSpecial
             Application.CutCopyMode = False
          Else
             Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
             Application.CutCopyMode = False
          End If
       Else
          If Cell.Offset(0, 7).Value = "Well Placed" Then
             Cell.EntireRow.Copy
             Sheets("Test Well Placed").Select
          If Range("A1").Value = "" Then
             Range("A1").PasteSpecial
             Application.CutCopyMode = False
          Else
             Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
             Application.CutCopyMode = False
          End If
          End If
       End If
    End If
Next
End Sub

ZAX