View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Code to copy header does not copy

Typo...

Sub GetWeekInfo()
Dim vName, vAns, lRow&, wk&, sMsg$
Dim wksTarget As Worksheet, rng As Range

Const sSheetNames$ = "Bodypump,Spinning,Zumba"

sMsg = "Enter a week number to find"
wk = Application.InputBox(sMsg, "Find Week Info", Type:=1)
If wk = False Then Exit Sub

Set wksTarget = ThisWorkbook.Sheets("Master")

'Do we Reset wksTarget OR Append new data?
sMsg = "Do you want to reset " & wksTarget.Name _
& ", or append new data?" & vbLf & vbLf _
& "Answer YES to clear existing data, NO to append new data."
vAns = MsgBox(sMsg, vbYesNo, "Reset Master Sheet")
If vAns = vbYes Then wksTarget.UsedRange.ClearContents

Application.ScreenUpdating = False
For Each vName In Split(sSheetNames, ",")
With Sheets(vName)
Set rng = .Columns(1).Find(wk, LookIn:=xlValues,
lookat:=xlPart)
If Not rng Is Nothing Then
lRow = wksTarget.Cells(wksTarget.Rows.Count, 1).End(xlUp).Row
lRow = IIf(lRow = 1, lRow, lRow + 2) '//reset or append
Set rng = Union(.Rows(1), .Rows(rng.Row))
rng.Copy wksTarget.Cells(lRow, 1)
End If 'Not rng Is Nothing
End With 'Sheets(vName)
Next 'vName

Application.ScreenUpdating = True
Set wksTarget = Nothing: Set rng = Nothing
End Sub


--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion