LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default Using Do Loops to copy data

You didn't share the rules for copying the rows. This copies all the rows
between "Agent Name:"'s.

Option Explicit
Sub testme()

Dim FoundCell As Range
Dim wks As Worksheet
Dim BotRow As Long
Dim TopRow As Long
Dim NewWks As Worksheet
Dim tName As String

Set wks = Worksheets("sheet1")

With wks

BotRow = .Cells.SpecialCells(xlCellTypeLastCell).Row

Set FoundCell = .Range("C1")

Do
With .Range("C:C")
Set FoundCell = .Cells.Find(What:="Agent Name:", _
After:=FoundCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)

End With

If FoundCell Is Nothing Then
MsgBox "nothing found!"
Exit Do
End If

If FoundCell.Row BotRow Then
Exit Do 'we've started over
Else
TopRow = FoundCell.Row
tName = FoundCell.Offset(0, 1).Value

'get rid of any existing sheet with that name???
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(tName).Delete
On Error GoTo 0
Application.DisplayAlerts = True

'try to create a new sheet
Set NewWks = Worksheets.Add
On Error Resume Next
NewWks.Name = tName
If Err.Number < 0 Then
MsgBox "Rename " & wks.Name & " Manually!"
Err.Clear
End If
On Error GoTo 0

'copy the data
.Range(.Rows(TopRow), .Rows(BotRow)).Copy _
Destination:=NewWks.Range("a1")

'get ready for the next time
BotRow = TopRow - 1
End If
Loop
End With
End Sub

Or maybe you have a date on each line and want to keep the dates that are
greater than a certain date.

Option Explicit
Sub testme()

Dim FoundCell As Range
Dim wks As Worksheet
Dim BotRow As Long
Dim TopRow As Long
Dim NewWks As Worksheet
Dim iRow As Long
Dim DestCell As Range
Dim myDate As Date
Dim tName As String

myDate = DateSerial(2007, 4, 28)

Set wks = Worksheets("sheet1")

With wks

BotRow = .Cells.SpecialCells(xlCellTypeLastCell).Row

Set FoundCell = .Range("C1")

Do
With .Range("C:C")
Set FoundCell = .Cells.Find(What:="Agent Name:", _
After:=FoundCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)

End With

If FoundCell Is Nothing Then
MsgBox "nothing found!"
Exit Do
End If

If FoundCell.Row BotRow Then
Exit Do 'we've started over
Else
TopRow = FoundCell.Row
tName = FoundCell.Offset(0, 1).Value

'get rid of any existing sheet with that name???
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(tName).Delete
On Error GoTo 0
Application.DisplayAlerts = True

'try to create a new sheet
Set NewWks = Worksheets.Add
On Error Resume Next
NewWks.Name = tName
If Err.Number < 0 Then
MsgBox "Rename " & wks.Name & " Manually!"
Err.Clear
End If
On Error GoTo 0

'copy the data version 2
Set DestCell = NewWks.Range("a1")
For iRow = TopRow To BotRow
If .Cells(iRow, "A").Value2 CLng(myDate) Then
.Rows(iRow).Copy _
Destination:=DestCell
Set DestCell = DestCell.Offset(1, 0)
End If
Next iRow

'get ready for the next time
BotRow = TopRow - 1
End If
Loop
End With
End Sub

Maybe it'll help--or not.

Mahnian wrote:

Wonderful, perfect.. This was just what I was looking for.

So, now that this has been provided to me, I am finding I am unable to alter
the code to do what else I need it too.

What I am ultimately looking to happen is this:

It scans down the column €śC€ť looking for €śAgent Name:€ť then grabbing the
name one column to the right and making a new sheet from that name. There
will be approximately 15 names.

Additionally, I need the sheet to grab each line between two names and copy
that information to the new sheet. The hook that will tell us that the line
needs to be copied is in column A and will contain a date (The date is not
static, but will always be in this format mm/dd/yyyy)

If anyone can further help me, I would be most appreciative.

"Dave Peterson" wrote:

<<snipped
--

Dave Peterson
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Loops David Excel Programming 1 February 10th 06 10:55 PM
Loops fugfug[_2_] Excel Programming 3 July 8th 05 10:53 AM
Vlookup macro that returns data from worksheet, then Loops xlsxlsxls[_3_] Excel Programming 4 October 23rd 04 05:48 PM
Vlookup macro that returns data from worksheet, then Loops xlsxlsxls[_4_] Excel Programming 0 October 23rd 04 05:43 PM
for each loops adncmm1980[_3_] Excel Programming 1 October 4th 04 12:56 PM


All times are GMT +1. The time now is 01:53 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"