View Single Post
  #26   Report Post  
Posted to microsoft.public.excel.programming
GS[_2_] GS[_2_] is offline
external usenet poster
 
Posts: 3,514
Default Copy adjacent Sheet and name from a list

Revised to handle existing sheets...

Sub CopySheetAndNameCopies_v2()
Dim vNames, sFormulas, n&, k&
vNames = Sheets("Summary").Range("BreakdownList")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If Sheets(vNames(n, 1)) Is Nothing Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1): sFormulas = "='" & vNames(n, 1)
& "'!G7"
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, 4) = sFormulas
End If 'Sheets(vNames(n, 1)) Is Nothing
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
End Sub

Sub CopySheetAndNameCopies_v3()
Dim vNames, vFormulaRefs, vaFormulas(1, 4)
Dim n&, k&
vNames = Sheets("Summary").Range("BreakdownList")
vFormulaRefs = Array("G7", "H7", "I7", "J7")

Application.ScreenUpdating = False
Sheets("Main Swb").Visible = True

For n = LBound(vNames) To UBound(vNames)
If Sheets(vNames(n, 1)) Is Nothing Then
Sheets("Main Swb").Copy after:=Sheets("Summary")
ActiveSheet.Name = vNames(n, 1)
For k = 1 To 4
vaFormulas(1, k) = "='" & vNames(n, 1) & "'!" & vFormulaRefs(k)
Next 'k
Sheets("Summary").Range("BreakdownList").Cells(n). Offset(,
1).Resize(1, UBound(vaFormulas, 2)) = vaFormulas
End If 'Sheets(vNames(n, 1)) Is Nothing
Next 'n

Sheets("Main Swb").Visible = False
Application.ScreenUpdating = True
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