I am trying to create a code that will duplicate and rename a template tab named "001". The thing is, I want each duplicated tab to be named as "001 +1". So the duplicated tabs' names would be "002,003,...,010,011...100,101, etc.
The number of duplicates will be decided by the number entered into a message box that will appear asking "How many copies would you like to make?". Also I would like for there to be no duplicates or tabs named "001 (2)" if more tab copies were to be added at a later time.
I really appreciate your help.
Here's one way to do it:
Sub Tester()
CreateSheets 4
End Sub
'EDIT: added specific workbook reference to qualify sheet references
Sub CreateSheets(howMany As Long)
Dim nm As String, sht As Worksheet
Dim i As Long, n As Long, wb As Workbook
Set wb = ThisWorkbook
For n = 1 To howMany
i = 2
Do
nm = Format(i, "000")
Set sht = Nothing
'see if this sheet exists...
On Error Resume Next
Set sht = wb.Sheets(nm)
On Error GoTo 0
If sht Is Nothing Then
'get the sheet to copy the template after
Set sht = wb.Sheets(Format(i - 1, "000"))
wb.Sheets("001").Copy after:=sht
wb.Sheets(sht.Index + 1).Name = nm
Exit Do 'made our copy
End If
i = i + 1
Loop
Next n
End Sub
Related
I'm hoping someone can help with this but I'm having the darnest time getting anything to work.
I have a rather large workbook with lots of worksheets, I have a report that runs and populates Column B with a "trigger"
Column A: is the name of all the worksheets in the workbook. Column B is the indicator that the specific worksheet needs to be moved, e.g. "Yes". I need to move the specified workbook into another workbook.
I can only find applicable examples for moving cells but it didn't work. Any help or direction will be greatly appreciated!
Dim WBK As Workbook
Dim WBK2 As Workbook
Set WBK= ThisWorkbook
Set WBK= Workbooks.Open(Filename:"ReportList.xlsx")
For i = 1 To Sheets("MoveSheet").End(xlDown).Row '(ERRORHERE)
If Sheets("MoveSheet").Range("B" & i) = "Move" Then
Sheets(Sheets("MoveSHeet").Range("A" & i)).Move After:=wkbk2.Sheets(1)
Else
End if
Next i
End Sub
Your posted code is not too far off - a few typos etc
Try this:
Sub Tester()
Dim wb As Workbook, wsList As Worksheet, c As Range
Dim wbDest As Workbook
Set wb = ThisWorkbook
Set wsList = wb.Worksheets("MoveSheet") 'your sheet with tab names and "Move" flag
Set wbDest = Workbooks.Open(Filename:="C:\Example\Path\ReportList.xlsx") 'provide the full path
For Each c In wsList.Range("A1:A" & wsList.Cells(Rows.Count, "A").End(xlUp).Row).Cells
If c.Offset(0, 1).Value = "Move" Then 'has a flag to be moved?
wb.Worksheets(c.Value).Move after:=wbDest.Sheets(wbDest.Sheets.Count) 'move after last sheet
End If
Next c
End Sub
Maybe a for each loop would be good.
Dim wkbk1 As Workbook - Main workbook
Dim wkbk2 As Workbook - Your other workbook
Set wkbk1 = ActiveWorkbook
Set wkbk2 = "input name here"
Dim ws As Worksheet
For Each ws In wkbk1.Sheets
'use if code to check if certain Criteria met'
ws.Move wkbk2.Sheets(Sheets.Count)
Next ws
I would have one loop to run through column A and check if the sheet needs to be move by checking the column B right alongside it. If column B contains the trigger, which would be checked with a if condition, then move the sheet to another workbook.
For i = 1 To Sheets("Sheet1").Range("A1").End(xlDown).Row
If Sheets("sheet1").Range("B" & i) = "Yes" Then
Sheets(Sheets("sheet1").Range("A" & i)).Move After:=Workbooks("Otherworkbook.xls").Sheets(1)
Else
End If
Next i
Something like this but might need to declare the second workbook with the full filename and directory.
I have a small app containing about 20 subs which runs perfectly... Every other time.
It fails, in the sub ImportData, the first time I add a code name to a newly created sheet. on the following line:
ThisWorkbook.VBProject.VBComponents(wsTarget.CodeName).Name = "Customers"
The code below contains three subs which which can recreate the issue. Important note: I can run the sub ImportData as many times in a row without any issues but if I call the sub "Sync()" twice in a row it will fail on the second attempt but works fine on the third attempt and so on (Maybe it doesn't like odd numbers..)
Any ideas as to why this is happening would be greatly appreciated.
FYT: I am running this code in Excel for Mac
Public LastRow As Long
Private wks As Worksheet
Sub Sync()
Call ImportData
Call SyncBoth
End Sub
Public Sub ImportData()
'++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++ 1. ImportData will allow user to select file to import data from
'+++++ 2. Copy both the Customers and Vendors data to their respective sheets
'++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim LastRow As Long
Dim MaxDate As Date
Dim ShCount As Integer
Dim SourceFile As String
SourceFile = "/Users/phild/Documents/RTPro/Customer and Vendor Raw Sync.xlsm"
Dim SourceWb As Workbook
Set SourceWb = Workbooks.Open(SourceFile)
Dim TargetWb As Workbook
Set TargetWb = ThisWorkbook
Dim sheet As Worksheet
For ShCount = 1 To 2
Select Case ShCount
Case 1
Set wsSource = SourceWb.Worksheets("Sheet1") 'Set Worksheet to copy data from
ThisWorkbook.Sheets("Customers").Delete 'Delete old Customer worksheet in this worksheet
Set sheet = ThisWorkbook.Sheets.Add 'Create New Customer woeksheet in this woekbook
sheet.Name = "Customers" 'Name new Customer worksheet
Set wsTarget = ThisWorkbook.Worksheets("Customers") 'Set Customers ws as the target ws
Debug.Assert ThisWorkbook.VBProject.Name <> vbNullString '<--Force the VBE to exist. Don't pollute the Immediate window
ThisWorkbook.VBProject.VBComponents(wsTarget.CodeName).Name = "Customers" 'Give Customers a Code name
'THE LINE OF CODE ABOVE RESULTS IN A Runtime error '32813"
' Method 'Name' of object '+VBComponent' failed
' EVERY OTHER TIME I RUN THE SUB Sync()
Case 2
Set wsSource = SourceWb.Worksheets("Sheet3") 'Set Worksheet to copy data from
ThisWorkbook.Sheets("Vendors").Delete 'Delete old Vendors worksheet in this worksheet
Set sheet = ThisWorkbook.Sheets.Add 'Create New Vendor worksheet in this woekbook
sheet.Name = "Vendors" 'Name new Vendor worksheet
Set wsTarget = ThisWorkbook.Worksheets("Vendors") 'Set Customers ws as the target ws
Debug.Assert ThisWorkbook.VBProject.Name <> vbNullString '<--Force the VBE to exist. Don't pollute the Immediate window '
ThisWorkbook.VBProject.VBComponents(wsTarget.CodeName).Name = "Vendors" 'Give Vendors a Code name
End Select
Call CleanTarget(wsTarget)
LastRow = Find_LastRow(wsSource)
wsSource.Range("A1:Z" & LastRow).Copy Destination:=wsTarget.Range("A1")
Next ShCount
SourceWb.Close
End Sub
Sub SyncBoth()
Dim ShCount As Integer
For ShCount = 1 To 2
Select Case ShCount
Case 1
Set wks = Customers 'Work in sheet("Customers")
LastRow = Find_LastRow(wks) 'Last row of "Customers"
Case 2
Set wks = Vendors 'Work in sheet("Vendors")
LastRow = Find_LastRow(wks) 'Last row of "Vendors"
End Select
Debug.Print wks.Name
Next ShCount
'Normally I have about 10 subs here that are called sequentially. But this is enough the cause the errorw
End Sub```
You're modifying the host VBA project at run-time - the code name identifier for Sheet1 is a compile-time, project-global scope object: even if it's not used anywhere, there's a legitimate chance that changing it requires recompiling the project.
So the code runs fine, up until it shoots its own foot off by renaming a global object; the next run now runs fine because now the compiled code matches the actual VBComponent in the project.
Consider having the macro in a separate VBA project, that prompts for which macro-enabled workbook to rename components in: because that VBA project won't be the VBA code that's compiled & running, it should "just work" then.
I am currently working on macro in a workbook with multiple worksheets, that aims to show and hide certain worksheets based on the values in a master worksheet. The worksheet names are also contained in the master worksheet and the main procedure looks at these values when referencing to a worksheet it needs to show or hide. The problem with this method is that, the macro will produce errors if the user changes the worksheet tab names. I was hoping to insert an additional procedure that makes the tab names of each worksheet equal to the values in the respective cell of the master worksheet. I came up with the following:
Sub SheetName()
If Not ActiveWorkbook Is ThisWorkbook Then Exit Sub
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
DataImport.Range("A13").Value = Sheet1.Name
End Sub
This code works fine but there are about 100+ worksheets in this workbook. I was wondering if there is a more efficient way to do this, as opposed to typing the same procedure 100 times. I've tried storing the worksheet code names in an array and looping the same procedure through the array, for example:
Sub test()
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
Dim index As Long
Dim ws(0 To 2) As Worksheet
Set ws = Array(Sheet1, Sheet2, Sheet3)
For i = 13 To 14
index = i - 13
DataImport.Cells(i, "A").Value = ws(index).Name
Next i
End Sub
but the error message "Can't Assign to Array" shows up. Sorry in advance if my code looks garbage, I am still new to VBA and I still have quite a lot to learn.
If you list the sheet codenames in ColA of your master sheet, then this code will update columns B and C with the current sheet tab names and indexes respectively:
Sub UpdateIndex()
Dim ws As Worksheet, cn As String, m
For Each ws In ThisWorkbook.Worksheets
cn = ws.CodeName
If cn <> DataImport.CodeName Then
'look for the codename in the Import sheet
m = Application.Match(cn, DataImport.Columns(1), 0)
If Not IsError(m) Then
'got a match - update this row
DataImport.Cells(m, "B").Value = ws.Name 'tab name
DataImport.Cells(m, "C").Value = ws.Index 'sheet index
End If
End If
Next ws
End Sub
Assumes you set the code name for your "Data Import" worksheet to DataImport.
If your code is driven by the sheet codename, it doesn't matter whether the user renames the tabs or changes the sheet order.
For your second attempt, you can use Excel built-in Sheets object and Workbook.Sheets collection:
Sub test()
Dim DataImport As Worksheet
Set DataImport = ThisWorkbook.Worksheets("Data Import")
Dim index As Long
Dim ws As Excel.Sheets
Set ws = ThisWorkbook.Sheets
For i = 13 To 14
index = i - 13
DataImport.Cells(i, "A").Value = ws(index).Name
Next i
End Sub
I've got a workbook with two spreadsheets named "WT-1" and "CL-1" (it could be more of them with diff. names).
When i.e. "WT-1" is active, I would like to be able to (by using a button with macro assigned to it) copy this current (active) spreadsheet and rename it in sequence like WT-2, WT-3, WT-4 etc .
I guess change needs to apply only to spreadsheets who's name contains "WT-" as the name change should be addressed to the new sheet only. All other existing worksheets should not be touched. here it is - Pls help :) It changes name of one new spreadsheet. If there is more than just 1 worksheet in my workbook, it doesn't work.
Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left(Trim(ws.Name), 3) = "WT-" Then
ws.Name = shtName(i)
i = i + 1
End If
Next ws
End Sub
Macro is suppose just to change the name of a new and freshly copied spreadsheet. So if I copy WT-2 and create new sheet named WT-2(2) and run macro - it will work and change new sheet name to WT-1 (being first name in the range on 'wslist') . That seems to be OK. But, if I have any other spreadsheet in my workbook (except active sheet and already copied new sheet) it doesn't work and gives me an error 1004 - "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic"
When I click on de-bag, this I found highlighted: ws.Name = shtName(i)
The issue is if you have the situation with following sheets
WT-1
WT-1 (2)
WT-2
Your code tries to rename WT-1 (2) into WT-2 but that already exists.
So a possibility was you would need to rename these to something else first like
WT-1
#WT-2
#WT-3
and then remove the # in another loop.
This way you prevent renaming into a name that already exists.
Option Explicit
Public Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 3) = "WT-" Then
'test if we run out of sheet names
If i > UBound(shtName) Then
MsgBox "Running out of sheet names … aborting"
Exit Sub
End If
ws.Name = "#" & shtName(i) 'add a # to all new sheet names
i = i + 1
End If
Next ws
'remove the # from the sheet nam
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 1) = "#" Then
ws.Name = Right$(ws.Name, Len(ws.Name) - 1)
End If
Next ws
End Sub
As QHarr pointed out it's probably a good idea to test if you are running out of sheet names.
I'd like to find the position of a worksheet as it is displayed in a workbook.
For example, assume I have a workbook starting with Sheet1, Sheet2 and Sheet3 in that order. Then a user drags Sheet2 to left, before Sheet1.
I want Sheet2 to return 1, Sheet1 to return 2 (and Sheet3 still to return 3).
I can't find a way to determine this in VBA.
This should do it:
Worksheets("Sheet1").Index
https://msdn.microsoft.com/en-us/library/office/ff836415.aspx
You can just iterate the Worksheets collection of the Workbook object. You can test yourself by running the following code, switch the order around in the UI, then run it again:
Option Explicit
Sub IterateSheetsByOrder()
Dim intCounter As Integer
Dim wb As Workbook
Set wb = ThisWorkbook
For intCounter = 1 To wb.Worksheets.Count
Debug.Print wb.Worksheets(intCounter).Name
Next intCounter
End Sub
To loop through all worksheets in a workbook use For Each WS in ThisWorkbook.Worksheets where WS is a worksheet object. Hence to obtain order of Excel worksheets as shown, we may also use the following code:
Sub LoopThroughWorksheets()
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
Debug.Print WS.Name
Next
End Sub
To obtain an output like Worksheets("Sheet1").Index then you may use this code
Sub IndexWorksheet()
Dim WS As Worksheet, n As Long
For Each WS In ThisWorkbook.Worksheets
n = n + 1
If WS.Name = "Sheet1" Then Debug.Print n
Next
End Sub
You can use the Sheets object. In your example, reading Sheets(2).Name should return Sheet1.
Right answer provided by Anastasiya-Romanova, but missing some important details.
There are two methods of doing this. First, with a For Each loop:
Sub ListSheetNames()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Debug.Print ws.Name
Next ws
End Sub
Second, with a basic For loop:
Sub ListSheetNames
Dim i As Long
For i = 1 to ThisWorkbook.Worksheets.Count
Debug.Print ThisWorkbook.Worksheets(i).Name
Next i
End Sub
You will find the second method will always output the names in the sheet index order, which is generally the order the sheets were created in unless you change the index. Simply rearranging the sheets from the workbook window won't change the index.
Therefore, the first method is the correct way to do this. It will always follow the tab order as you see on your screen.
Below code works even if sheet is renamed or its sequence is changed.
Sub Display_Sheet_Tab_Number()
Dim WorksheetName As String
Dim n As Integer
WorksheetName = Sheet1.Name
MsgBox Worksheetname
n = Sheets(WorksheetName).Index 'n is index number of the sheet
MsgBox "Index No. = " & n
End Sub