Posted to microsoft.public.excel.programming
|
|
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
|