' delete specific rows from a worksheet by copying the good ones to another sheet and deleting the old one
Sub Step6()
Dim myRange As String ' String to hold the range variables of the good cells
myRange = ""
Dim mySheet As String ' the name of the worksheet to be revised
Dim oldSheet As Worksheet ' the sheet we are woring on
Set oldSheet = ActiveWorkbook.Worksheets("Sheet1")
mySheet = oldSheet.Name
' set up to loop through all of the rows in the used range on the worksheet
Dim n As Long
Dim nlast As Long
Dim rw As Range
Set rw = ActiveWorkbook.ActiveSheet.UsedRange.Rows
nlast = rw.Count
For n = 1 To nlast
' build the list of rows to be detained
If (rw.Cells(n, 2).Value = "" And rw.Cells(n, 3).Value = "" And rw.Cells(n, 4).Value = "") Then
' this row is to be deleted, so do nothing
Else
' add this row the the list of rows to be retained
' rw.row is the first row of the unsed range of the worksheet
myRange = myRange & CStr(n + rw.Row - 1) & ":" & CStr(n + rw.Row - 1) & ","
End If
Next n
rw.Select
' myRange now has a list of rows to be retain. It may be null.
If (myRange = "") Then ' do nothing
Else
' remove the trailing "," from the range
myRange = Mid(myRange, 1, Len(myRange) - 1)
' copy the good rows range to a new workseet and get rid of the old one
' create a new worksheet and put it after the old sheet
Dim newSheet As Worksheet
Set newSheet = ActiveWorkbook.Worksheets.Add(after:=oldSheet)
' copy the good rows to the new sheet
oldSheet.Activate
On Error Resume Next
ActiveSheet.Range(myRange).Select
If (Err.Number <> 0) Then
MsgBox Err.Description
Stop
End If
Selection.Copy
newSheet.Paste
' delete the old sheet and rename the new one
Application.DisplayAlerts = False ' don't show the delete confirm popup
oldSheet.Delete
newSheet.Name = mySheet
Application.DisplayAlerts = True
End If
End Sub
Bookmarks