I am trying to create a roadway design spreadsheet that can be used over and over again for hundreds of alignments. I got the everything working with a master sheet to be copied and two sheets used as lookup tables. I want to add two buttons in the corner that can be used to:
1) Copy the Master Sheet and rename it the alignmentname-##. This will be within the current workbook and will be used for each curve in the roadway alignment. It would be even better if there was a way to delete out these two buttons in the copied sheets.
2) A button to copy just the Master sheet, and two supplement sheets to a new workbook.
So far I have:
Sub Button10_Click()
Worksheets("Master (DO NOT MODIFY)").Copy _
Before:=ActiveWorkbook.Sheets("Master (DO NOT MODIFY)")
End Sub
It works fine for now just creating a copy of the base file, but I have not been able to rename it. The code for renaming the sheet is not working and I am not quite sure why.
Sheets(Count).Name = Range("H7").Value & "-" & Count
Where count is a public variable that goes up by one everytime a new curve is addedand H7 is the name of the alignment.
I have also played with the ActiveSheet. activesheet and Worksheets
Code for the first Button:
Public Count As Integer
Sub Button10_Click()
If Count = 0 Then
Count = 1
End If
Dim ws As Worksheet
Worksheets("Master (DO NOT MODIFY)").Copy _
Before:=ActiveWorkbook.Sheets("Master (DO NOT MODIFY)")
Set ws = ActiveSheet
ws.Name = Range("C2").Value & Count
Count = Count + 1
End Sub
Is this what you are trying? You cannot use count as the sheet is moved before the sheet and if you are incrementing the count then it will refer to the wrong sheet.
Sub Button10_Click()
Dim ws As Worksheet
Worksheets("Master (DO NOT MODIFY)").Copy _
Before:=ActiveWorkbook.Sheets("Master (DO NOT MODIFY)")
Set ws = ActiveSheet
ws.Name = Range("H7").Value & "-" & Count
End Sub
Regarding your 2nd question, you can try it like this. I am assuming that the master is not the last or the 2nd last sheet. Also there are two more sheets after the master.
Sub Button10_Click()
Dim ws As Worksheet
Dim wsMaster As Worksheet
Dim MyArray(1 To 3) As String
Dim n As Long
Set wsMaster = ThisWorkbook.Worksheets("Master (DO NOT MODIFY)")
wsMaster.Copy Before:=wsMaster
Set ws = ActiveSheet
ws.Name = Range("H7").Value & "-" & Count
n = ThisWorkbook.Sheets.Count
MyArray(1) = wsMaster.Name
MyArray(2) = ThisWorkbook.Sheets(n - 1).Name
MyArray(3) = ThisWorkbook.Sheets(n).Name
'~~> This will create a new workbook with the 3 sheets
ThisWorkbook.Sheets(MyArray).Copy
End Sub
Related
Its been a long time. I need a VBA to name my sheets Test 1, Test 2 etc from the active sheet and all to the right.
OR do the same for all selected sheets. IE, I'd select a block of 10 sheets and run my macro to rename them "Test 1,...Test 10"
it doesn't matter which method but there are sheets that I don't want the names changed so I either need the following to work ONLY on a block of selected sheets OR from an active sheet and all to the right.
I'm working from the following code:
Sub nameShts()
Dim i As Integer
For i = 1 To Worksheets.Count
Worksheets(i).Name = "Week" & i
Next i
End Sub
You were close for idea to loop from selected sheet to last sheet. Instead of 1 to Worksheets.Count use ActiveSheet.Index to Worksheets.Count
Sub nameShts()
Dim i As Integer
For i = ActiveSheet.Index To Worksheets.Count
Worksheets(i).Name = "Week" & i
Next i
End Sub
To loop the selected sheets, use ThisWorkbook.Windows(1).SelectedSheets to get a collection of the selected sheets.
Then simply loop the collection.
Select your desired sheets and run this:
Sub nameShts()
Dim i As Integer
i = 1
Dim sh As Worksheet
For Each sh In ThisWorkbook.Windows(1).SelectedSheets
sh.Name = "Week" & i
i = i + 1
Next sh
End Sub
It will only change the sheets selected
Worksheet.Next seems like a good fit for this problem
Sub nameShts()
Dim ws As Worksheet
Set ws = ActiveSheet
Do
ws.Name = "Test " & (ws.Index - ActiveSheet.Index + 1)
Set ws = ws.Next
Loop While Not ws Is Nothing
End Sub
I have a list of items and a new sheet button like this:
For each item you have to be able to create new worksheet when you click on that button. It copies a worksheet from a template, one worksheet for a single row. Now i want to be able to copy some of the info from a row i select to that new worksheet cells when i click on the button and maybe rename the worksheet as a value in one of the cells (ID). The values i need are ID and name, maybe few more.
Sub AddNameNewSheet2()
Dim CurrentSheetName As String
CurrentSheetName = ActiveSheet.Name
'Add New Sheet
Dim i As Byte, sh As Worksheet
For i = 1 To 1
Sheets("Predlozak").Copy After:=Sheets("Predlozak")
Set sh = ActiveSheet
Next i
On Error Resume Next
'Get the new name
ActiveSheet.Name = InputBox("Name for new worksheet?")
'Keep asking for name if name is invalid - Here i want to change worksheet name to a specific cell value from selected row.
Do Until Err.Number = 0
Err.Clear
ActiveSheet.Name = InputBox("Try Again!" _
& vbCrLf & "Invalid Name or Name Already Exists" _
& vbCrLf & "Please name the New Sheet")
Loop
On Error GoTo 0
End Sub
Anyone has an idea how can i make this work?
Here's what I came up with, I also thought checkboxes would be a good way to pick the line, it's quite simple:
Sub AddNameNewSheet2()
Dim x As Long
Dim wks As Worksheet
Dim IdCell As Range, NamCell As Range, FormCell As Range
Set wks = ActiveSheet
Set IdCell = wks.Range("A:A").Find("TRUE").Offset(0, 1)
Set FormCell = IdCell.End(xlToRight)
Set NamCell = IdCell.Offset(0, 1)
Sheets.Add After:=Sheets(1), Type:= _
"C:\Users\*yournamehere*\AppData\Roaming\Microsoft\Templates\*yourtemplatehere*.xltm"
ActiveSheet.Name = NamCell
Dim wks2T As ListObject
Set wks2T = ActiveSheet.ListObjects(1)
With wks2T
.ListColumns(1).Range(2) = IdCell.Value
.ListColumns(2).Range(2).Value = NamCell.Value
.ListColumns(3).Range(2).Value = FormCell.Value
End With
End Sub
I made the template a table cause it is easier to specify exactly where to put stuff. And it is more manageable as more data is added in the future.
Sheet1 image
Sheet2 image
I have a workbook with a master sheet for school report cards. I have a macro applied to a button for exporting information from the master sheet to separate, newly-generated sheets in the same workbook. A1:C71 is the template and goes to every new sheet, and the following columns of info, from D1:71 to Q1:71, each appear in separate sheets (always in D1:71).
Here's the screenshot (http://imgur.com/a/ZDOVb), and here's the code:
`Option Explicit
Sub parse_data()
Dim studsSht As Worksheet
Dim cell As Range
Dim stud As Variant
Set studsSht = Worksheets("Input")
With CreateObject("Scripting.Dictionary")
For Each cell In studsSht.Range("D7:Q7").SpecialCells(xlCellTypeConstants, xlTextValues)
.Item(cell.Value) = .Item(cell.Value) & cell.EntireColumn.Address(False, False) & ","
Next
For Each stud In .keys
Intersect(studsSht.UsedRange, studsSht.Range(Left(.Item(stud), Len(.Item(stud)) - 1))).Copy Destination:=GetSheet(CStr(stud)).Range("D1")
Next
End With
studsSht.Activate
End Sub
Function GetSheet(shtName As String) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(shtName)
If GetSheet Is Nothing Then
Set GetSheet = Sheets.Add(after:=Worksheets(Worksheets.Count))
GetSheet.Name = shtName
Sheets("Input").Range("A1:C71").Copy
GetSheet.Range("A1:D71").PasteSpecial xlAll
GetSheet.Range("A1:B71").EntireColumn.ColumnWidth = 17.57
GetSheet.Range("C1:C71").EntireColumn.ColumnWidth = 54.14
GetSheet.Range("D1:D71").EntireColumn.ColumnWidth = 22
End If
End Function`
I would now like to create a separate button to split the sheets into separate workbooks so that the master sheet can be kept for record keeping and the individual workbooks can be shared with parents online (without divulging the info of any kid to parents other than their own). I would like the workbooks to be saved with the existing name of the sheet, and wonder if there's a way to have the new workbooks automatically saved in the same folder as the original workbook without having to input a path name? (It does not share the same filename as any of the sheets).
I tried finding other code and modifying it, but I just get single blank workbooks and I need as many as have been generated (preferably full of data!), which varies depending on the class size. Here's the pathetic attempt:
`Sub split_Reports()
Dim splitPath As String
Dim w As Workbook
Dim ws As Worksheet
Dim i As Long, j As Long
Dim lastr As Long
Dim wbkName As String
Dim wksName As String
Set wsh = ThisWorkbook.Worksheets(1)
splitPath = "G:\splitWb\"
Set w = Workbooks.Add
For i = 1 To lastr
wbkName = ws
w.Worksheets.Add(After:=w.Worksheets(Worksheets.Count)).Name = ws
w.SaveAs splitPath
w.Close
Set w = Workbooks.Add
Next i
End Sub`
I have learned so much, and yet I know so little.
Maybe this will start you off, just some simple code to save each sheet as a new workbook. You would probably need some check that the sheet name is a valid file name.
Sub x()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
ws.Copy
ActiveWorkbook.Close SaveChanges:=True, Filename:=ws.Name & ".xlsx"
Next ws
End Sub
I need to cycle through sheets of index 3 tip last sheet and run a code. I tried something like this but its doesn't work.
If (ws.sheetIndex > 2) Then
With ws
'code goes here
End With
End If
I did a search but don't find a solution to this problem. Help would be much appreciated.
I also tried:
Dim i As Long, lr As Long
Dim ws As Worksheet
Windows("Book1").Activate
With ActiveWorkbook
Set ws = .Worksheets("index")
For i = 3 To 10
'code goes here
Next i
End With
You can try the following, which iterates over all worksheets in your workbook and only "acts" for worksheets with index 3 or above.
Dim sheet As Worksheet
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Index > 2 Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(1, 1).Value = "hi"
End If
Next
Note that this doesn't put a hard limit on the number of sheets you have (10 or whatever), as it will work with any number of worksheets in your active workbook.
EDIT
If you want the code to run on worksheets with names "Sheet" + i (where i is an index number from 3 onwards), then the following should help:
Dim sheet As Worksheet
Dim i As Long
For i = 3 To ActiveWorkbook.Worksheets.Count
Set sheet = ActiveWorkbook.Worksheets(i)
If sheet.Name = "Sheet" & i Then
' Do your thing with each "sheet" object, e.g.:
sheet.Cells(2, 2).Value = "hi"
End If
Next i
Of course, this means that the names of your worksheets need to always follow this pattern, so it's not best practice. However, if you're sure the names are going to stay like this, then it should work well for you.
Try excluding first and second sheet using name:
Public Sub Sheets3andUp()
Dim ws As Worksheet
Dim nameOfSheet1 As String
Dim nameOfSheet2 As String
nameOfSheet1 = "Sheet1"
nameOfSheet2 = "Sheet2"
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> nameOfSheet1 And ws.Name <> nameOfSheet2 Then
'Code goes here
Debug.Print ws.Name
End If
Next ws
End Sub
Note that the user can reorder the sheets in the Worksheets Collection, so it is better to refer to the sheets by CodeName (which the user cannot change), and exclude by CodeName the sheets to be skipped, as here:
Public Sub TestLoop()
On Error GoTo ErrHandler
Dim ws As Worksheet, s As String
For Each ws In Worksheets
If ws.CodeName <> "Sheet2" Then
s = s & vbNewLine & ws.CodeName
End If
Next ws
s = "WorksheetList (except Sheet2:" & vbNewLine & vbNewLine & s
MsgBox s, vbOKOnly, "Test"
EndSUb:
Exit Sub
ErrHandler:
Resume EndSUb
End Sub
If I drag Sheet 3 to precede Sheet1, the MsgBox outputs:
WorksheetList (except Sheet2:
Sheet3
Sheet1
I'm trying to get a handle to the worksheet that was created by a copy operation. following code used to work:
Dim wsTempl As Worksheet, pageCount as Long
Set wsTempl = Sheets("Template")
For pageCount = 1 To 5
wsTempl.Copy After:=Sheets(Sheets.Count)
Set ws = Sheets(Sheets.Count)
ws.Name = "p" & pageCount
Next
But stopped when adding VeryHidden worksheets to the workbook. now my Sheets(Sheets.Count) is getting the VeryHidden sheet instead of the sheet I added last.
Of course I could use
Set ws = Sheets(wsTempl.Name & " (2)")
ws.Name = "p" & pageCount
But that seems so ugly, is this really the only way? Can somebody think of another way?
to replicate the issue:
Open a New workbook, Name the first Sheet 'Template' & delete the other sheets
alt-f11 - insert code module & paste the above code
F5 should show you that it works.
insert a worksheet, using the worksheet tabs drag it to the end of collection
set it to VeryHidden in VBA IDE
F5 again, the first code listing should fail
Reason seems to be that the Copy After:= does not copy after VeryHidden Sheets, thus the part of the code to rename the sheet always renames the VeryHidden Sheet
The Copy method of a worksheet makes the newly created sheet active so you should be able to do this.
Dim wsTempl As Worksheet, i as int
Set wsTempl = Sheets("Template")
For i = 1 To 5
wsTempl.Copy After:=Sheets(Sheets.Count)
Set ws = ThisWorkbook.ActiveSheet
ws.Name = "p" & pageCount
Next