Thread: Macro To Copy Specific Data Into A Separate Worksheet

Change

For j = 3 to lrow

to

 For j = 5 to lrow

Right click on the sheet where you need the validation and select "View Code" and input this code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("I" & Target.Row).Value = "" Then
        MsgBox "Please enter score", vbCritical, "Enter Score:"
        Range("I" & Target.Row).Select
    End If
End Sub

However, i observed that you have grouped the radio buttons. I dont think this code will work properly in this case. Try ungrouping it and then it should work.

What error do you get?

I am not getting any error. Can you try again please?

Ok got it. Since the last 2 rows dont need to be evaluated (they only contain titles), change your for statement to

 for j = 5 to lrow -2

Its just small small things that we ignore. Change this line

 For j = 5 To lrow - 2
            If Worksheets(i).Range("E" & j).Value <> "" And Worksheets(i).Range("D" & j).Value <> "Section Total" And _
            Worksheets(i).Range("I" & j).Value <= 3 And Worksheets(i).Range("X" & j+1).Value <= 2 Then

to

 For j = 5 To lrow - 2
            If Worksheets(i).Range("E" & j).Value <> "" And Worksheets(i).Range("D" & j).Value <> "Section Total" And _
            Worksheets(i).Range("I" & j).Value <= 3 And Worksheets(i).Range("X" & j).Value <= 2 Then

Change this part of your code from

 With Worksheets("Action")
                    .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = Worksheets(i).Name
                    .Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = Worksheets(i).Range("B" & j).Value
                    .Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = Worksheets(i).Range("C" & j).Value
                    .Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = Worksheets(i).Range("G" & j).Value
                    .Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = Worksheets(i).Range("H" & j).Value
                End With

to

 With Worksheets("Action")
                   lastrow=.range("B" & rows.count).end(xlup).row
                    .Range("B" & lastrow).Value = Worksheets(i).Name
                    .Range("C" & lastrow).Value = Worksheets(i).Range("B" & j).Value
                    .Range("D" & lastrow).Value = Worksheets(i).Range("C" & j).Value
                    .Range("E" & lastrow).Value = Worksheets(i).Range("G" & j).Value
                    .Range("F" & lastrow).Value = Worksheets(i).Range("H" & j).Value
                End With

Also, at the top of your code, add another DIM statement - Dim lastrow as long

Sorry my bad. The previous code that i gave you. Add a "+1" to the lastrow. In other words, it should read as

  With Worksheets("Action")
                   lastrow=.range("B" & rows.count).end(xlup).row
                    .Range("B" & lastrow+1).Value = Worksheets(i).Name
                    .Range("C" & lastrow+1).Value = Worksheets(i).Range("B" & j).Value
                    .Range("D" & lastrow+1).Value = Worksheets(i).Range("C" & j).Value
                    .Range("E" & lastrow+1).Value = Worksheets(i).Range("G" & j).Value
                    .Range("F" & lastrow+1).Value = Worksheets(i).Range("H" & j).Value
                End With