New range overwrites other range in create sheet macro

[wcollatz]

Hi,

I'm having trouble creating a macro to combine data from several sheets in a
large workbook into one summary sheet. The macro first creates the new
sheet, names it then I attempt to add text data to some cells before I copy
data from the other sheets. I can only get as far as creating the new sheet
because, when I ask Excel to add text to a subsequent cell (for my section
headings) on the new sheet, it overwrites the info I put in the first cell
(A1.)

I reduced the macro to just a couple if commands for troubleshooting but I
still cannot get it to work. I originally used Range("A3").Select
instead of "offset" here but both result in cell A1 (which should read
"Seasonal Summary" getting overwritten with "SOIL DATA". Any thoughts?

Code:

Sub CombineWeeklies2()

On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet
Sheets(1).Name = "Summary"


' add sheet title and headings
Range("A1").Select
Selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.FormulaR1C1 = "Seasonal Summary"
Range("A1").Offset(2, 0).Select
ActiveCell.FormulaR1C1 = "SOIL DATA"


End Sub

Thanks for your thoughts.
Wesley

 

[Joel]

This is the method people usally use to create a summary sheet. I used the
column Header and row headers on each sheet to create the header on the
summary sheet.

Sub CombineWeeklies2()

'see if sheet exists
Found = False
For Each Sht In Sheets
If Sht.Name = Summary Then
Set SumSht = Sht
Found = True
Exit For
End If
Next Sht

If Found = False Then
Set SumSht = Worksheets.Add(before:=Sheets(1))
With SumSht
.Name = "Summary"
' add sheet title and headings
With .Range("A1")
.Font.Underline = xlUnderlineStyleSingle
.FormulaR1C1 = "Seasonal Summary"
End With
End With
End If

'New Row and Column Count in Summary Sheet
NewCol = 2
NewRow = 2
'go through each sheet
For Each Sht In Sheets
If Sht.Name <> "Summary" Then
With Sht
'Get LastRow
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
'get every cell in the sheet with data
For RowCount = 2 To LastRow
RowHeader = .Range("A" & RowCount)
'Check if row exists on summary sheet
Set c = SumSht.Columns("A").Find(what:=RowHeader, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
RowNum = NewRow
SumSht.Range("A" & RowNum) = RowHeader
NewRow = NewRow + 1
Else
RowNum = c.Row
End If

For ColCount = 2 To LastCol
'only move cells with data to summary sheet
If .Cells(RowCount, ColCount) <> "" Then
Data = .Cells(RowCount, ColCount)
ColHeader = .Cells(1, ColCount)
'Find column on summary sheet
Set c = SumSht.Rows(1).Find(what:=ColHeader, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
SumSht.Cells(1, NewCol) = ColHeader
SumSht.Cells(RowNum, NewCol) = Data
NewCol = NewCol + 1
Else
SumSht.Cells(RowNum, c.Column) = Data
End If
End If
Next ColCount
Next RowCount
End With
End If
Next Sht
End Sub