Copy Entire Row based on Cell Value
Try something like this. Change the new sheet name as required.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lngRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
OldSht = Target.Parent
Set NewSht = Sheets("Sheet2")
NewRow = 1
With Parent
lastRow = .Range("H" & Rows.Count).End(xlUp).Row
For lngRow = 5 To lastRow
If .Range("H" & lngRow).Value = "Closed" Then
.Rows(lngRow).Copy _
Destination:=NewSht.Rows(NewRow)
NewRow = NewRow + 1
.Rows(lngRow).Hidden = True
Else
.Rows(lngRow).Hidden = False
End If
Next lngRow
End With
Application.EnableEvents = False
Application.ScreenUpdating = False
End Sub
"Vincent A. Somoredjo" wrote:
Hallo,
Can you please provide some assistance?
I have the following code in a worksheet (Register), if the value in Column
H is "Closed" I am hiding the row in the WorkSheet (Register). At the same
time I want to copy the hidden row to another sheet (Closed Issues).
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lngRow As Long
Application.ScreenUpdating = False
For lngRow = 5 To lastRow
If Range("H" & lngRow).Value = "Closed" Then
Rows(lngRow + 0).Hidden = True
Else
Rows(lngRow + 0).Hidden = False
End If
Next
Application.ScreenUpdating = False
End Sub
Can this be done?
Thanks in advance for your support.
|