I am really new to code so excuse the simple question:
I currently have the below code which creates new tabs in excel from a list which works perfectly, however I now have a 'template 2' and I would like it to create template 1 then template 2 for each item in the 'input' tab using range F8 for 'template 1' and G8 for 'template 2'. I can get it to do all the items in F8 for template 1 and then all the items in G8 for template 2 but I cant manage to get it to alternate.
I ultimately want to create template 1 then template 2, copy and paste values into an new file and save, then repeat for the next line down in the input tab.
Thank you in advance
Sub Addnewsheets()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Input").Range("F8")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets("Template 1").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value 'Renames the new worksheets
Next MyCell
Worksheets("End").Move after:=Worksheets(Worksheets.Count)
End Sub
If I interpret your issue correctly, just add these two lines before the Next MyCell
Sheets("Template 2").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Offset(, 1).Value 'Renames the new worksheets based on column G
For clarity sake, the For Loop becomes:
For Each MyCell In MyRange
Sheets("Template 1").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value 'Renames the new worksheets
Sheets("Template 2").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Offset(, 1).Value 'Renames the new worksheets based on column G
Next MyCell
Related
VBA noob here. I've got Dashboard, Master, and Aggregate sheets. I created a macro so that when one presses the "create copies" button, the Master sheet is copied into new "Tool" sheets named based on a list. After the new sheets are created, I'd like specific columns from each of these new sheets to be copied into the aggregate (or inserted as new table columns). It's difficult when the amount of sheets being added and their names are variable.
Here's the code for creating the new sheets:
Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range
Dim tbl As ListObject
Set MyRange = Sheets("Dashboard").Range("A24:A28")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets.Add after:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Worksheets("RTM - Master").Cells.Copy ActiveSheet.Range("A1")
ActiveSheet.ListObjects(1).Name = MyCell.Value
ActiveSheet.Cells(1, 6).Value = MyCell.Value & " " & "Capability"
ActiveSheet.Cells(1, 7).Value = MyCell.Value & " " & "LOE"
ActiveSheet.Cells(1, 8).Value = MyCell.Value & " " & "Pts"
Range("f1", Range("f1").End(xlDown)).Select
Next MyCell
End Sub
Thanks in advance!
I am looking to split data from my master worksheet but retain said data on the same excel book. I need a new worksheet created based on a range of cells i.e. C2:C19 from master (I have been able to do this using the following code).
Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Master").Range("C2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
End Sub
For each new worksheet that is created I would like the headings and all data within the relevant row on Master pasted onto the new worksheet. i.e C2 = 10, Worksheet name 10 with headers A1 - Q1 from Master and all data from A2 - Q2 I then need each additional worksheet to do the same based on the C detail
I am very new to VBA and will be looking to take some training, in the meantime please help.
Thanks,
Paul.
Sub CreateSheetsFromAList()
Dim startsheet As Worksheet
Dim newsheet As Worksheet
Dim MyCell As Range, MyRange As Range
Set startsheet = Sheets("Sheet1")
Set MyRange = startsheet.Range("C2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Set newsheet = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets(Sheets.Count).Name = MyCell.Value
startsheet.Rows(1).Copy newsheet.Range("a1")
MyCell.EntireRow.Copy newsheet.Range("a2")
Next MyCell
End Sub
Hi I'm trying to create a copy of a worksheet in a workbook for each entry in a range, then rename the worksheet based on the value of the current cell in that range. It was working before, but now it doesn't name the new sheets. If I make blank worksheets, it will name them, however if I copy the worksheet it won't name the worksheet properly. I am also trying to set the value of C1 on each sheet to the value that is from the range. Below is my code:
Sub CreateSEMSheets()
On Error GoTo GetOut
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Strategic End Market Data").Range("SEMListGenerated")
For Each MyCell In MyRange
If MyCell.Value = "" Then GoTo GetOut
Sheets("StrategicMktPlan").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "SMP - " & MyCell.Value
Sheets(Sheets.Count).Range("C1").Value = MyCell.Value
Next MyCell
GetOut:
End Sub
Please help!!! Thanks in advance.
Edit: I figured out why it's not working - there was a hidden sheet that was the last sheet in the workbook and it was renaming that over and over. Any idea how to prevent this?
After Copy() method of Worksheet object the newly created worksheet is the active one:
For Each MyCell In MyRange
If MyCell.Value = "" Then GoTo GetOut
Sheets("StrategicMktPlan").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = "SMP - " & MyCell.Value
.Range("C1").Value = MyCell.Value
End With
Next MyCell
Per your edit, you could use this:
Sub VisibleSheetsCount()
'UpdatebyKutoolsforExcel20150909
' https://www.extendoffice.com/documents/excel/3187-excel-count-visible-sheets.html
Dim xSht As Variant
Dim I As Long
For Each xSht In ActiveWorkbook.Sheets
If xSht.Visible Then I = I + 1
Next
MsgBox I & " sheets are visible", , "Kutools for Excel"
End Sub
Then do .Copy(After:=Sheets(I)) I think would work.
I would like to create a new worksheet in my workbook; name based on the information in the C column (starting at C4) of the "Summary" Worksheet. I have the following VBA so far but when it gets to a blank cell it stops. I need it to ignore blank cells and continue. Any help?
Sub CreateSheetsFromAListTEST()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Summary").Range("C4")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets.Add after:=Sheets(Sheets.Count) 'creates a new workbook
Sheets(Sheets.Count).Name = MyCell.Value 'renames the new workbook
Next MyCell
End Sub
replace
Set MyRange = Sheets("Summary").Range("C4")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets.Add after:=Sheets(Sheets.Count) 'creates a new workbook
Sheets(Sheets.Count).Name = MyCell.Value 'renames the new workbook
Next MyCell
by
set MyRange=range(sheets("Summary").[c4],sheets("Summary").cells(rows.count,"C").end(xlup))
For Each MyCell In MyRange
if len(mycell.text)>0 then
Sheets.Add after:=Sheets(Sheets.Count) 'creates a new workbook
Sheets(Sheets.Count).Name = MyCell.Value 'renames the new workbook
end if
Next MyCell
I am still very new at VBA and I am having trouble getting some code to work. I have one sub where I want to create worksheets based off of a list of names in a worksheet named AllCities. The list of city names starts in cell A2. The worksheets need to be named after the cell value in the list, and the list should be able to be updated. The code right now works kind of, but it doesn't add new worksheets if I add to the list of names. My second sub is supposed to delete an any worksheets that do not correspond to a city on the list. My delete sub is just deleting every worksheet right now.
Insert Worksheet Code:
Sub insertSheets()
Dim myCell As Range
Dim MyRange As Range
Dim MyRange2 As Range
Set MyRange = Sheets("AllCities").Range("A2")
Set MyRange2 = Range(MyRange, MyRange.End(xlDown))
For Each myCell In MyRange2
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = myCell.Value
Next myCell
End Sub
Delete Worksheet Code:
Sub deleteSheets()
Dim wks As Worksheet
Dim MyRange As Range
Dim myCell As Range
Set wks = Sheets("AllCities")
With wks
Set MyRange = Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With
On Error Resume Next
Application.DisplayAlerts = False
For Each myCell In MyRange
Sheets(myCell.Value).Delete
Next myCell
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
Thanks for any help that you have!
You're attempting to use two different methods (that will yield different results) to find the last cell in the range.
In your insertSheets procedure, you're using:
Set MyRange2 = Range(MyRange, MyRange.End(xlDown))
This is the same effect as holding Ctrl and pressing the down key which will find the last cell before a blank cell is present.
In your deleteSheets procedure you use:
Set MyRange = Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
This has a different effect from the way you searched in the insertSheets procedure as it starts from the bottom of the worksheet to find the true last cell in the range.
I suggest amending your insertSheets procedure to:
Sub insertSheets()
Dim myCell As Range
Dim MyRange As Range
Dim MyRange2 As Range
With Sheets("AllCities")
Set MyRange = .Range("A2")
Set MyRange2 = .Range(MyRange, .Rows.Count, "A").End(xlUp)
End With
For Each myCell In MyRange2
If Not myCell.Value = vbNullString Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = myCell.Value
End If
Next myCell
End Sub
This will also validate that the cell is not blank and therefore prevent Excel from throwing an error because you trying to rename a new worksheet to having no name.