Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
angy_2 pe Simpatie
 | Femeie
21 ani
Constanta
cauta Barbat
21 - 63 ani |
|
TonyTzu
Moderator
 Inregistrat: acum 12 ani
Postari: 252
|
|
Copy 1 sheet and paste multiple times:
Sub CopySheet_PasteMore()
Dim x As Integer
x = InputBox("Enter number of times to copy Current Sheet")
For numtimes = 1 To x
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveWorkbook.ActiveSheet
Next
End Sub
|
Source:
Rename all sheets by entering a specific name (if no name is entered it renames them all 1, 2, 3, 4 etc.
Sub ChangeSheetName()
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "Rename multiple sheets"
newName = Application.InputBox("Desired name, leave empty to number sheets from 1 to x (x = total number of sheets)", xTitleId, "", Type:=2)
For i = 1 To Application.Sheets.Count
Application.Sheets(i).Name = newName & i
Next
End Sub
|
VBA code to rename multiple worksheets by specific cell value in each worksheet of the active workbook
Sub RenameTabs()
'Updateby20140624
For x = 1 To Sheets.Count
If Worksheets(x).Range("A1").Value <> "" Then
Sheets(x).Name = Worksheets(x).Range("A1").Value
End If
Next
End Sub
|
Source for both the above:
Using range name:
For Each ws In ActiveWindow.SelectedSheets
count = count + 1
ws.Name = nmRange.Cells(count).Value
Next ws
|
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 17 ani
Postari: 2186
|
|
Rename all sheets after sheet named A to values in Range A1:A30 in activesheet:
Sub ShtRnmRng()
Dim c As Range
Dim J As Integer
J = 0
For Each c In Range("A1:A30")
J = J + 1
If Sheets(J).Name = "A" Then J = J + 1
Sheets(J).Name = c.Text
Next c
End Sub |
Source:
From source above, a more robust version of the code above:
| As noted, this macro is very simplistic and should, in all likelihood, be a lot more robust. For instance, what should be done if there are more (or fewer) than 13 worksheets in the current workbook? What should be done if there are empty cells in the range A1:A12? What should be done if someone runs the macro and "Control" isn't the active worksheet? What should be done if there are two identical values in A1:A12? What if there are leading or trailing spaces on one or more names in the range A1:A12? These and (most likely) a whole range of other questions can affect how the macro finally looks. Here's a commented version of the macro that takes into account several of the possibilities just mentioned: |
Sub ShtRnmRng()
Dim c As Range
Dim J As Integer
Dim K As Integer
Dim sName As String
Dim w(12) As String
Dim bGo As Boolean
Dim sTemp As String
bGo = True
If Worksheets.Count <> 13 Then
' Check to make sure exactly 13 worksheets in workbook
bGo = False
sTemp = "There are more than 13 worksheets."
End If
If ActiveSheet.Name <> "Control" Then
' Check to make sure Control is active
bGo = False
sTemp = "Control worksheet is not active."
Else
' Check for empty and duplicate cells in range
J = 0
For Each c In Range("A1:A12")
sName = Trim(c.Text)
If sName <> "" Then
For K = 1 to J
If LCase(w(K)) = LCase(sName) Then
bGo = False
sTemp = "Duplicate sheet names in list."
End If
Next K
If bGo Then
' Everything still good; add name
J = J + 1
w(J) = sName
End If
End If
Next c
End If
If bGo Then
K = 0
For J = 1 To 12
K = K + 1
If Sheets(K).Name = "Control" Then K = K + 1
Sheets(K).Name = w(J)
Next J
Else
MsgBox(sTemp)
End If
End Sub |
_______________________________________
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
My adapted version of rename based on a range in Active Sheet:
Sub ShtRnmRng()
Dim c As Range
Dim J As Integer
xTitleId = "Choose sheet name to ignore rename"
shhNM = Application.InputBox("Type sheet name:", xTitleId, "", Type:=2)
J = 0
For Each c In Range("A1:A30")
J = J + 1
If Sheets(J).Name = shhNM Then J = J + 1
Sheets(J).Name = c.Text
Next c
End Sub |
TBA
- what to do if there are blanks or errors or not allowed characters in range
- end sub if you cancel on input box
More info:
_______________________________________
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 17 ani
Postari: 2186
|
|
My adapted version with a bit more advanced options:
- it asks you to type the name of the sheet you will ignore rename on (oldNM)
- it asks you to type the naming template (newNM), eg: if you type Sh, the sheets will be named Sh1, Sh2 and so on
- if oldNM is not the first sheet, it is moved in first place (on the left)
- sheets are renamed from 1 to sheet count minus 1 (first sheet) based on the template you chose
Sub ShtRnmInpt()
Dim c As Range
Dim J As Integer
xTitleId = "Choose sheet to ignore rename on;"
oldNM = Application.InputBox("Type sheet name:", xTitleId, "", Type:=2)
xTitleId = "Choose name for renamed sheets"
newNM = Application.InputBox("Type name template:", xTitleId, "", Type:=2)
On Error Resume Next
If oldNM.Index <> 1 Then Sheets(oldNM).Move Before:=ActiveWorkbook.Sheets(1)
For i = 1 To Application.Sheets.Count
If Sheets(i).Name = oldNM Then i = i + 1
Application.Sheets(i).Name = newNM & i - 1
Next
End Sub |
TBA
- rename all sheets after current (active sheet) -
- rename all sheets after specified sheet (in input box)
- make 1 big code to give you multiple options, including rename by range, and rename all sheets with no exclusions
- make it so that when you cancel input box value it will ignore them where they appear further in the code
- end sub if you cancel on input box
Multiple choice input boxes:
Creating user forms:
rs.index source
_______________________________________
|
|
| pus acum 5 ani |
|