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

Sub Capture0405()

set oldsht = activesheet
Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
newsht.Name = "0405"

NewRow = 1
with oldsht
OldRow = 1
do while .Range("I" & OldRow) <> ""
if .Range("I" & OldRow) = 4 or _
.Range("I" & OldRow) = 5 then
.Range("A" & OldRow & ":H" & OldRow).copy _
Destination:=NewSht.Range("A" & Newrow)
NewRow = NewRow + 1
end if
OldRow = OldRow + 1
Loop
End Sub


"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
>

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
<(E-Mail Removed)> 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

This is great. Thank you for the help.

"Joel" wrote:

>
> Sub Capture0405()
>
> set oldsht = activesheet
> Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
> newsht.Name = "0405"
>
> NewRow = 1
> with oldsht
> OldRow = 1
> do while .Range("I" & OldRow) <> ""
> if .Range("I" & OldRow) = 4 or _
> .Range("I" & OldRow) = 5 then
> .Range("A" & OldRow & ":H" & OldRow).copy _
> Destination:=NewSht.Range("A" & Newrow)
> NewRow = NewRow + 1
> end if
> OldRow = OldRow + 1
> Loop
> End Sub
>
>
> "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
> >

Wow, I appreciate this very much. The macro works very well. Thank you for
the help.

"Chip Pearson" wrote:

>
> 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
> <(E-Mail Removed)> 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
>