copying dynamic range based on cell outside of range

  • Thread starter Thread starter xcelelder
  • Start date Start date
X

xcelelder

i am copying a dynamic range of cells from twelve different worksheets.
i need to select a range that starts of g10 on every sheet, but ends
differently on every sheet. the range ends depending on column A in the
last row of each range, the word 'total'. i would like to select the
range in column g10 down to the cell corresponding with 'total' in
column a in column g. For example, if there is 'total' is in a56, i
want to select and copy g10-g56. If on another sheet 'total' is in a68,
i want to select and copy g10-g68. there is information below the range.
i want to ignore the data below altogther. here is the code that i have
now for the first sheet. it grabs G10 through the last cell in column
g. any help would be appreciated. thanks.


Code:
 
Maybe like this:

Sub cpy()
Dim cRow As Long
Dim fRng As Range
'find first empty row on Sales Report for copy
cRow = Sheets("SALES REPORT").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets("January 2005")
With Sheets("January 2005").Columns(1)
Set fRng = .Find("Total")
End With
If Not fRng Is Nothing Then
.Range(.Cells(10, 7), .Cells(fRng.Row, 7)).Copy _
Sheets("SALES REPORT").Cells(cRow, 1)
End If
End With
End Sub

Hope this helps
Rowan
 
Hi Xcelelder,

Try something like:

'======================>>
Sub Tester05()
Dim Rng As Range
Dim rw As Long
Dim sh As Worksheet
Dim destCell As Range
Dim arr As Variant

arr = Array("January 2005", "February 2005", _
"March 2005", "April 2005", "May 2005", _
"June 2005", "July 2005", "August 2005", _
"September 2005", "October 2005", _
"November 2005", "December 2005")

For Each sh In ActiveWorkbook.Worksheets
If Not IsError(Application.Match(sh.Name, arr, 0)) Then
Set destCell = Sheets("SALES REPORT"). _
Cells(Rows.Count, "A").End(xlUp)(2)

rw = 0

On Error Resume Next
rw = sh.Columns(1).Find(What:="total", _
After:=Range("A10"), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Row
On Error GoTo 0

If rw > 0 Then
sh.Range("G10:G" & rw).Copy Destination:=destCell
End If
End If
Next sh

End Sub
'<<======================
 
Thanks to both of you who replied. I already started using Rowan's
solution before I saw Norman's. Thanks Norman for the contribution
though. Rowan's workd perfectly. Thanks!
 
Back
Top