VBA Macro to skip hidden rows

[slohman]

Can you skip rows that are hidden in a worksheet. I need WS Option1 to find all words Safeplay and copy contents to WS Safeplay.

Sub MoveOption_to_Safeplay()
Dim SheetName As String
SheetName = "Option1"
Dim i As Long
Dim MyCol As Integer
Dim MyRow As Integer

Application.ScreenUpdating = False

ActiveSheet.Unprotect

Sheets("Safeplay").Range("B17:L40").ClearContents
   
LR = Sheets(SheetName).Range("D" & Rows.Count).End(xlUp).Row
MyCol = 2
MyRow = 17

    For i = 7 To 900
        If Sheets(SheetName).Range("D" & i).Value = "Safeplay" Then
            Do Until Sheets("Safeplay").Cells(MyRow, MyCol).Value = "" Or MyRow > 40
                MyRow = MyRow + 1
            Loop
            If MyRow <= 40 Then
                Sheets("Safeplay").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("A" & i).Value
                MyRow = MyRow + 1
            Else
                MsgBox "You have ran out of room.  Some entries were not copied"
            Exit For
        End If
        End If
    Next i

LR = Sheets(SheetName).Range("D" & Rows.Count).End(xlUp).Row
MyCol = 4
MyRow = 17
    For i = 7 To 900
        If Sheets(SheetName).Range("D" & i).Value = "Safeplay" Then
            Do Until Sheets("Safeplay").Cells(MyRow, MyCol).Value = "" Or MyRow > 40
                MyRow = MyRow + 1
            Loop
            If MyRow <= 40 Then
                Sheets("Safeplay").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("C" & i).Value
                MyRow = MyRow + 1
            Else
                MsgBox "You have ran out of room.  Some entries were not copied"
            Exit For
        End If
        End If
    Next i

LR = Sheets(SheetName).Range("D" & Rows.Count).End(xlUp).Row
MyCol = 6
MyRow = 17
    For i = 7 To 900
        If Sheets(SheetName).Range("D" & i).Value = "Safeplay" Then
            Do Until Sheets("Safeplay").Cells(MyRow, MyCol).Value = "" Or MyRow > 40
                MyRow = MyRow + 1
            Loop
            If MyRow <= 40 Then
                Sheets("Safeplay").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("E" & i).Value
                MyRow = MyRow + 1
            Else
                MsgBox "You have ran out of room.  Some entries were not copied"
            Exit For
        End If
        End If
    Next i

LR = Sheets(SheetName).Range("D" & Rows.Count).End(xlUp).Row
MyCol = 8
MyRow = 17
    For i = 7 To 900
        If Sheets(SheetName).Range("D" & i).Value = "Safeplay" Then
            Do Until Sheets("Safeplay").Cells(MyRow, MyCol).Value = "" Or MyRow > 40
                MyRow = MyRow + 1
            Loop
            If MyRow <= 40 Then
                Sheets("Safeplay").Cells(MyRow, MyCol).Value = Sheets(SheetName).Range("F" & i).Value
                MyRow = MyRow + 1
            Else
                MsgBox "You have ran out of room.  Some entries were not copied"
            Exit For
        End If
        End If
    Next i
   
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   
    Sheets("Safeplay").Range("N2").Select

Application.ScreenUpdating = True

End Sub

 

[Hui]

Did you consider using a formula based approach rather than a macro?
I am not sure which column on Option 1 should be the unit costs column

Refer attached file:

To understand these formula refer to: http://chandoo.org/wp/2011/11/18/formula-forensics-003/

 

[Sathish KV]

If ActiveCell.EntireRow.Hidden = True Then
ActiveCell.Offset(1, 0).Select
End If

 

[slohman]

Thanks for the code, where do I place this into my vba