VBA not working properly

**stevemills04** · 04-26-2013, 02:44 PM

Hi All, thanks for any help you can provide. I have been through and tested this code many times and cannot figure it out.

My goal here is to go through all of the rows. If column J = Promotable, copy that row to the Promotable tab. If J is Well Placed, move to the Well Placed tab.

It works great for the Promotables, then it stops and does not copy any Well Placed. The odd thing is I originally had this code reading Range("C1:C"...) and Value = "Community Mgr" and it worked great. When I changed the Range and Value, it crapped out on me.

Sub Macro1()

Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
For Each Cell In Range("J1:J" & LR)
    If Cell.Value = "Promotable" Then
       Cell.EntireRow.Copy
           With Sheets("Promotable")
            .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
             Application.CutCopyMode = False
           End With


       If Cell.Value = "Well Placed" Then
             Cell.EntireRow.Copy
                 With Sheets("Well Placed")
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
                    Application.CutCopyMode = False
                 End With

       End If
    End If
Next
End Sub

**AndyLitch** · 04-26-2013, 02:50 PM

Your second If THEN is nested inside your first... Try this...

Sub Macro1()

Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
For Each Cell In Range("J1:J" & LR)
    If Cell.Value = "Promotable" Then
       Cell.EntireRow.Copy
           With Sheets("Promotable")
            .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
             Application.CutCopyMode = False
           End With
       End If '<-------- This was your problem (in the wrong place)

       If Cell.Value = "Well Placed" Then
             Cell.EntireRow.Copy
                 With Sheets("Well Placed")
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
                    Application.CutCopyMode = False
                 End With

       End If
    
Next
End Sub

**snb** · 04-26-2013, 02:56 PM

Sub Macro1()
  for each it in array("Promotable","Well Placed")
    with usedrange
      .autofilter 10,it
      .offset(1).copy sheets(it).cells(rows.count,1).end(xlup).offset(1)
      .autofilter
    end with
  next
End Sub