I am looking to copy only a segement of a row from a primary database to a
summary sheet. Currently, my script below copies the EntireRow
(c.EntireRow.Copy_). Is there a way to set a range such that I only copy
over...say "d to Z" versus the EntireRow?

Sub Rectangle2_Click()

CodeName = InputBox("Enter Project Code", Range("a1:a3").Find(Cells(1,
1)).Offset(rowOffset:=2, columnOffset:=1).Value)

Range("a1:a5").Find(Cells(1, 1)).Offset(rowOffset:=1, columnOffset:=2).Value
= CodeName

Worksheets("Extract").Select
Worksheets("Extract").Range("a8:z2000").ClearConte nts

RowCount = 8

With Worksheets("Database").Range("a1:z2000")
Set c = .Find(Cells(3, 2))

If Not c Is Nothing Then
firstAddress = c.Address
Do

c.EntireRow.Copy _
Destination:=Worksheets("APTS Extract").Rows(RowCount)
RowCount = RowCount + 1

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With

End Sub

Range(cells(c.row,"d"),cells(c.row,"z")).copy

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I am looking to copy only a segement of a row from a primary database to a
summary sheet. Currently, my script below copies the EntireRow
(c.EntireRow.Copy_). Is there a way to set a range such that I only copy
over...say "d to Z" versus the EntireRow?

Sub Rectangle2_Click()

CodeName = InputBox("Enter Project Code", Range("a1:a3").Find(Cells(1,
1)).Offset(rowOffset:=2, columnOffset:=1).Value)

Range("a1:a5").Find(Cells(1, 1)).Offset(rowOffset:=1,
columnOffset:=2).Value
= CodeName

Worksheets("Extract").Select
Worksheets("Extract").Range("a8:z2000").ClearConte nts

RowCount = 8

With Worksheets("Database").Range("a1:z2000")
Set c = .Find(Cells(3, 2))

If Not c Is Nothing Then
firstAddress = c.Address
Do

c.EntireRow.Copy _
Destination:=Worksheets("APTS Extract").Rows(RowCount)
RowCount = RowCount + 1

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With

End Sub

Don,

Thanks for the response!

I've replace "c.EntireRow" with your script
"Range(cells(c.row,"d"),cells(c.row,"z")).copy and get a "Run-time
error'1004". Your further assistance is greatly appreciated!

"Don Guillett" wrote:

Range(cells(c.row,"d"),cells(c.row,"z")).copy

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I am looking to copy only a segement of a row from a primary database to a
summary sheet. Currently, my script below copies the EntireRow
(c.EntireRow.Copy_). Is there a way to set a range such that I only copy
over...say "d to Z" versus the EntireRow?

Sub Rectangle2_Click()

CodeName = InputBox("Enter Project Code", Range("a1:a3").Find(Cells(1,
1)).Offset(rowOffset:=2, columnOffset:=1).Value)

Range("a1:a5").Find(Cells(1, 1)).Offset(rowOffset:=1,
columnOffset:=2).Value
= CodeName

Worksheets("Extract").Select
Worksheets("Extract").Range("a8:z2000").ClearConte nts

RowCount = 8

With Worksheets("Database").Range("a1:z2000")
Set c = .Find(Cells(3, 2))

If Not c Is Nothing Then
firstAddress = c.Address
Do

c.EntireRow.Copy _
Destination:=Worksheets("APTS Extract").Rows(RowCount)
RowCount = RowCount + 1

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With

End Sub

Sorry, I forgot to include the dot for the WITH

.Range(cells(c.row,"d"),cells(c.row,"z")).copy
or
.Range(.cells(c.row,"d"),.cells(c.row,"z")).copy


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
Don,

Thanks for the response!

I've replace "c.EntireRow" with your script
"Range(cells(c.row,"d"),cells(c.row,"z")).copy and get a "Run-time
error'1004". Your further assistance is greatly appreciated!

"Don Guillett" wrote:

Range(cells(c.row,"d"),cells(c.row,"z")).copy

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I am looking to copy only a segement of a row from a primary database to
a
summary sheet. Currently, my script below copies the EntireRow
(c.EntireRow.Copy_). Is there a way to set a range such that I only
copy
over...say "d to Z" versus the EntireRow?

Sub Rectangle2_Click()

CodeName = InputBox("Enter Project Code", Range("a1:a3").Find(Cells(1,
1)).Offset(rowOffset:=2, columnOffset:=1).Value)

Range("a1:a5").Find(Cells(1, 1)).Offset(rowOffset:=1,
columnOffset:=2).Value
= CodeName

Worksheets("Extract").Select
Worksheets("Extract").Range("a8:z2000").ClearConte nts

RowCount = 8

With Worksheets("Database").Range("a1:z2000")
Set c = .Find(Cells(3, 2))

If Not c Is Nothing Then
firstAddress = c.Address
Do

c.EntireRow.Copy _
Destination:=Worksheets("APTS Extract").Rows(RowCount)
RowCount = RowCount + 1

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With

End Sub

Don,

Thanks!!.....it runs great (I had placed dots in several locations but could
not get the correct order).

Thanks again for all your help!,

Chris

"Don Guillett" wrote:

Sorry, I forgot to include the dot for the WITH

.Range(cells(c.row,"d"),cells(c.row,"z")).copy
or
.Range(.cells(c.row,"d"),.cells(c.row,"z")).copy


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
Don,

Thanks for the response!

I've replace "c.EntireRow" with your script
"Range(cells(c.row,"d"),cells(c.row,"z")).copy and get a "Run-time
error'1004". Your further assistance is greatly appreciated!

"Don Guillett" wrote:

Range(cells(c.row,"d"),cells(c.row,"z")).copy

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I am looking to copy only a segement of a row from a primary database to
a
summary sheet. Currently, my script below copies the EntireRow
(c.EntireRow.Copy_). Is there a way to set a range such that I only
copy
over...say "d to Z" versus the EntireRow?

Sub Rectangle2_Click()

CodeName = InputBox("Enter Project Code", Range("a1:a3").Find(Cells(1,
1)).Offset(rowOffset:=2, columnOffset:=1).Value)

Range("a1:a5").Find(Cells(1, 1)).Offset(rowOffset:=1,
columnOffset:=2).Value
= CodeName

Worksheets("Extract").Select
Worksheets("Extract").Range("a8:z2000").ClearConte nts

RowCount = 8

With Worksheets("Database").Range("a1:z2000")
Set c = .Find(Cells(3, 2))

If Not c Is Nothing Then
firstAddress = c.Address
Do

c.EntireRow.Copy _
Destination:=Worksheets("APTS Extract").Rows(RowCount)
RowCount = RowCount + 1

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With

End Sub

Glad to help

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
Don,

Thanks!!.....it runs great (I had placed dots in several locations but
could
not get the correct order).

Thanks again for all your help!,

Chris

"Don Guillett" wrote:

Sorry, I forgot to include the dot for the WITH

.Range(cells(c.row,"d"),cells(c.row,"z")).copy
or
.Range(.cells(c.row,"d"),.cells(c.row,"z")).copy


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
Don,

Thanks for the response!

I've replace "c.EntireRow" with your script
"Range(cells(c.row,"d"),cells(c.row,"z")).copy and get a "Run-time
error'1004". Your further assistance is greatly appreciated!

"Don Guillett" wrote:

Range(cells(c.row,"d"),cells(c.row,"z")).copy

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"CROD" wrote in message
...
I am looking to copy only a segement of a row from a primary database
to
a
summary sheet. Currently, my script below copies the EntireRow
(c.EntireRow.Copy_). Is there a way to set a range such that I only
copy
over...say "d to Z" versus the EntireRow?

Sub Rectangle2_Click()

CodeName = InputBox("Enter Project Code",
Range("a1:a3").Find(Cells(1,
1)).Offset(rowOffset:=2, columnOffset:=1).Value)

Range("a1:a5").Find(Cells(1, 1)).Offset(rowOffset:=1,
columnOffset:=2).Value
= CodeName

Worksheets("Extract").Select
Worksheets("Extract").Range("a8:z2000").ClearConte nts

RowCount = 8

With Worksheets("Database").Range("a1:z2000")
Set c = .Find(Cells(3, 2))

If Not c Is Nothing Then
firstAddress = c.Address
Do

c.EntireRow.Copy _
Destination:=Worksheets("APTS Extract").Rows(RowCount)
RowCount = RowCount + 1

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address < firstAddress
End If

End With

End Sub