Summarizing/Copying dynamic ranges of data to new sheet?

**Tomkat** · 10-04-2010, 11:11 AM

OK, I'm not sure how to ask this question...

How do I summarize dynamic ranges of data to a new sheet?

For example on sheet1 I might have...

     A     B     C
1    x     x     x
2    x     x     x
3    x     x     x

and on sheet2 I might have...

     A     B     C
1    o     o     o
2    o     o     o
3    o     o     o

and these ranges are dynamic, meaning they could be more or less rows (columns are static)

I would like to have a summary sheet showing the 2 ranges combined sequentially like so...

     A     B     C
1    x     x     x
2    x     x     x
3    x     x     x
4    o     o     o
5    o     o     o
6    o     o     o

is there any way to do this?

I have searched online, but haven't found an answer, mainly because I'm not sure exactly how to phrase my search.

Any help would be greatly appreciated!

**pike** · 10-04-2010, 10:23 PM

Hi Tomkat,
welcome to the forum
A quick search of the forum return this

Dim ws As Worksheet
Dim lastRng As Range
Application.ScreenUpdating = False 'speed up code

For Each ws In ThisWorkbook.Worksheets
Set lastRng = ThisWorkbook.Sheets("Sheet3").Range("a33").End(xlUp).Offset(1, 0)
    Select Case ws.Name
        Case "Sheet3" 'exlude
        'do nothing
        Case Else
        ws.Activate
       
        'copy data from individual sheets
        Range("a1", Range("h" & Range("A65536").End(xlUp).Row)).Copy lastRng
    End Select
Next
Application.CutCopyMode = False 'clear clipboard
Application.ScreenUpdating = True

**Tomkat** · 10-08-2010, 01:53 PM

Thanks!

I figured I'd have to use a macro, and since the beginnings of my dynamic ranges were different on each page, I ended up using the "xltoright" and "xldown" selection functions...

Here's my code (hopefully someone can tweak it to their needs)

Sub SummarizeHexData()
'
' SummarizeHexData Macro
'

'
    Application.ScreenUpdating = False 'speed up code

    Sheets.Add.Name = "HexSummary"
    
    
    Sheets("(LOD Header)").Select
    Range("T1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("HexSummary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    
    
    Sheets("!vertexes").Select
    Range("S3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("HexSummary").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    

    Sheets("(Normals Summary)").Select
    Range("C1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("HexSummary").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Sheets("(Face Summary)").Select
    Range("B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("HexSummary").Select
    Selection.End(xlDown).Select
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    

    Sheets("(SubObj)").Select
    Range("S1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("HexSummary").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10092441
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    
    Sheets("(CP-Summary)").Select
    If Range("A1") > 0 Then
    Range("D1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("HexSummary").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16763904
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Else
    End If
    
    Sheets("(CV-Summary)").Select
    If Range("A1") > 0 Then
    Range("B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("HexSummary").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 8388736
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Else
    End If
    
    Sheets("HexSummary").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "00"
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Columns.AutoFit
 
    Application.ScreenUpdating = True

End Sub