Thread: Capture
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Chip Pearson Chip Pearson is offline
external usenet poster
 
Posts: 7,247
Default Capture


Try code like the following. It will create the sheet "0405" if it
doesn't exist.

Sub AAA()

Dim LastRow As Long
Dim RowNdx As Long
Dim SourceWS As Worksheet
Dim DestWS As Worksheet
Dim Dest As Range
Dim DeleteThese As Range
Dim R As Range

Set SourceWS = Worksheets("Sheet1") '<<< Change
On Error Resume Next
Set DestWS = Worksheets("0405")
If DestWS Is Nothing Then
' doesn't exist. create it.
With ThisWorkbook.Worksheets
Set DestWS = .Add(after:=.Item(.Count))
DestWS.Name = "0405"
End With
End If
With DestWS
Set Dest = .Cells(.Rows.Count, "A").End(xlUp)
If Dest.Value < vbNullString Then
Set Dest = Dest(2, 1)
End If
End With
On Error GoTo 0
With SourceWS
LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
For RowNdx = 1 To LastRow
Set R = .Cells(RowNdx, "i")
Select Case R.Value
Case "04", "05"
If DeleteThese Is Nothing Then
Set DeleteThese = R.EntireRow
Else
Set DeleteThese = _
Application.Union(DeleteThese, R.EntireRow)
End If
R.EntireRow.Copy Destination:=Dest
Set Dest = Dest(2, 1)
Case Else
' do nothing
End Select
Next RowNdx
End With

If Not DeleteThese Is Nothing Then
DeleteThese.Delete
End If

End Sub


Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)



On Thu, 28 May 2009 13:31:01 -0700, Sal
wrote:

Every time Column I has “04” or “05” in a row, I would like to cut that
entire row Columns A:AH, create a new worksheet named “0405” , and paste
those cut rows into the new worksheet, so that the rows do not overlap.

Here is what I have so far. Any help would be appreciated.

Sub Capture0405()

Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
newsht.Name = "0405"
End Sub