![]() |
|
#1
|
|||
|
|||
|
Hello all,
What I need to do is to rename the created sheet (Products) with the name of the sheets in ws , that are used for the calculations (fill Products worksheet with data). The format will be TEMPLATE-games-play2 etc , only the sheets with data Please find attached an example Thank you Cross posted Oops! We ran into some problems. | MrExcel Message Board and Rename Worksheet based on worksheets - Excel VBA / Macros - OzGrid Free Excel/VBA Help Forum |
|
#2
|
||||
|
||||
|
Your mrexcel link is broken, it's:
Rename Worksheet based on calculated worksheets | MrExcel Message Board try: Code:
Sub BuildTemplateINm()
Application.ScreenUpdating = False
Dim Ws As Worksheet, desWS As Worksheet, rng As Range, lRow As Long, NweShtName As String, ALOIFOTS As Boolean
'unconditionally delete all sheets whose name begins 'TEMPLATE':
Application.DisplayAlerts = False
For Each Ws In Worksheets
If Left(Ws.Name, 8) = "TEMPLATE" Then Ws.Delete
Next Ws
Application.DisplayAlerts = True
'Always add a new TEMPLATE sheet:
Set desWS = Sheets.Add(after:=Sheets(Sheets.Count))
With desWS
.Name = "TEMPLATE"
.Range("A1").Resize(, 2).Value = Array("Description", "Quantity")
End With
NweShtName = "TEMPLATE" 'the future name of this worksheet which will be built upon.
For Each Ws In Sheets
ALOIFOTS = False 'At Least One Item Found On This Sheet
If Left(Ws.Name, 8) <> "TEMPLATE" Then
With Ws
If .Range("H" & .Rows.Count).End(xlUp).Row > 12 Then
For Each rng In .Range("H14", .Range("H" & .Rows.Count).End(xlUp))
If (IsNumeric(rng.Value)) And (rng.Value <> 0) Then
ALOIFOTS = True
With desWS
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 2).Value = Array(rng.Offset(, -6), rng)
End With
End If
Next rng
End If
If .Range("O" & .Rows.Count).End(xlUp).Row > 12 Then
For Each rng In .Range("O14", .Range("O" & .Rows.Count).End(xlUp))
If (IsNumeric(rng.Value)) And (rng.Value <> 0) Then
ALOIFOTS = True
With desWS
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 2).Value = Array(rng.Offset(, -6), rng)
End With
End If
Next rng
End If
End With
End If
If ALOIFOTS Then NweShtName = NweShtName & "-" & Ws.Name
Next Ws
With desWS
.Columns.AutoFit
.Name = NweShtName
End With
Application.ScreenUpdating = True
End Sub
|
|
#3
|
|||
|
|||
|
@p45cal
Thank you for your reply! Thsi is working great! Thank you! |
|
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| combining worksheets of same xls into a single worksheet | pavan.polish | Excel | 2 | 03-14-2018 06:48 PM |
How to copy workbooks from different worksheets into one new worksheet
|
abbani | Excel | 3 | 12-12-2016 04:09 AM |
Combining different worksheets into a single worksheet.
|
jimmy2016 | Excel Programming | 4 | 10-15-2016 09:05 AM |
copy cells from a worksheet into other worksheets based on Criteria
|
Elton Wolter | Excel Programming | 4 | 04-16-2016 08:44 AM |
| Variable to rename a tab in a worksheet via VBA | Chayes | Excel Programming | 5 | 08-07-2012 02:03 AM |