Randy

Here's one way. Comments in the cell, but post back if you have questions.

Sub MoveTotals()

Dim cell As Range
Dim Rng As Range
Dim DestRng As Range
Dim sh As Worksheet, sh2 As Worksheet

'Identify the sheet to pull from
Set sh = ThisWorkbook.Sheets("Sheet1")

'Identify the sheet to write to
Set sh2 = ThisWorkbook.Sheets("Sheet2")

'Set up a range of column D to loop through
Set Rng = Intersect(sh.Columns(4), sh.UsedRange)

'Set up the first cell to write
Set DestRng = sh2.Range("A400")

'Loop through the cells
For Each cell In Rng.Cells

'If it's a total row
If Right(cell, 5) = "Total" Then

'Copy the whole row and paste to destrng
cell.EntireRow.Copy DestRng

'Move destrng down one row for next total
Set DestRng = DestRng.Offset(1, 0)
End If
Next cell

End Sub
--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Randy" wrote in message
...
Need some code that will copy nine subtotalled rows to a
remote range in same worksheet, as a preparation for
identifying the remote range as a table. This table would
then become the object of an external data refresh in
another worksheet of the same workbook.

The data in the subtotalled worksheet varies as to the
number of rows, so I can't directly reference the s/t rows
in the data set as the table object. Thus the need to
copy the contents of the s/t rows to a remote range. The
s/t labels are always in column D (Internal Total, Shared
Total, etc), so I would like a way to programatically:
1. identify the s/t rows
2. copy the entire values of each of the nine s/t rows to
a remote range in same worksheet (A400, A401, etc).

I'm not a skilled VBA programmer. This is the beginning
code I've been working with, but I'm way short of a
solution.

If "RIGHT($D2,5)=""Total""" Then
ActiveRows.Select
Selection.Copy
Range("A400").Select
Selection.PasteSpecial
Paste:=xlValues,Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
EndIf

Thanks for your help!
Randy