View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
J.W. Aldridge J.W. Aldridge is offline
external usenet poster
 
Posts: 425
Default delete all rows except those meeting criterias

This is what i meant...
Create sheets based on value in column A.
Transfer data to each created sheet based on names in column A.

Tried adapting to what i need, but getting error on

Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue)


Sub Create_sheets_from_data()
'copy rows to worksheets based on value in column A
'assume the worksheet name to paste to is the value in Col A
Dim CurrentCell As Range
Dim SourceRow As Range
Dim Targetsht As Worksheet
Dim TargetRow As Long
Dim CurrentCellValue As String


'start with cell A1 on Sheet1
Set CurrentCell = Worksheets("ERRORS").Cells(1, 1) 'row 1 column 1


Do While Not IsEmpty(CurrentCell)
CurrentCellValue = CurrentCell.Value
Set SourceRow = CurrentCell.EntireRow


'Check if worksheet exists
On Error Resume Next
Testwksht = Worksheets(CurrentCellValue).Name
If Err.Number = 0 Then
'MsgBox CurrentCellValue & " worksheet Exists"
Else
'TO INSERT SHEETS BEFORE A SPECIFIED SHEET, CHANGE NAME
BELOW(END)
'Worksheets.Add(befo=Sheets("TA_END")).Name =
CurrentCellValue
End If


On Error GoTo 0 'reset on error to trap errors again


Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue)
'note: using CurrentCell.value gave me an error if the value was
numeric


' Find next blank row in Targetsht - check using Column A
TargetRow = Targetsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, 1)


'do the next cell
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop
End Sub