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
Related
I have created a macro to create worksheets from a list,this works fine but i have a problem, if i only have one item in the list i get an error, here is the macro:
Sub CreateSheetsFromAList()
Application.ScreenUpdating = False
Sheets("Master").Select
Sheets("Stock Removal").Visible = True
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Master").Range("A14")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets("Stock Removal").Copy after:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
Sheets("Stock Removal").Select
ActiveWindow.SelectedSheets.Visible = False
Application.ScreenUpdating = True
End Sub
You should rather use xlUp than xlDown, it is safer!
You selected the whole column previously (from row 14, until the end of the sheet!)
This will run smoothly! ;)
Sub CreateSheetsFromAList()
Application.ScreenUpdating = False
Dim wsM As Worksheet, wsSR As Worksheet
Dim MyCell As Range, MyRange As Range, LastRow As Double
Set wsM = ThisWorkbook.Sheets("Master")
Set wsSR = ThisWorkbook.Sheets("Stock Removal")
wsM.Select
wsSR.Visible = True
Set MyRange = wsM.Range("A14")
LastRow = wsM.Range("A" & wsM.Rows.Count).End(xlUp).Row
If LastRow > 14 Then
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
wsSR.Copy after:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
Else
wsSR.Copy after:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyRange.Value ' renames the new worksheet
End If
wsSR.Select
ActiveWindow.SelectedSheets.Visible = False
Application.ScreenUpdating = True
End Sub
The problem is in case if only Cell A14 has data, and the entire column A (below cell A14) is blank, in that case MyRange.End(xlDown) will result in "A1048576". So you need to find the last row in Column A, and then check if it's 14 >> If it is then your MyRange should consist of 1 cell, and that's Cell A14.
Try the code below to replace the way you Set MyRange :
With Sheets("Master")
If .Cells(.Rows.Count, "A").End(xlUp).Row = 14 Then ' if only cell A14 has data in entire Column A
Set MyRange = Sheets("Master").Range("A14")
Else
Set MyRange = Sheets("Master").Range("A14", Range("A14").End(xlDown))
End If
End With
Try with changing:
Set MyRange = Sheets("Master").Range("A14")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
To:
With Sheets("Master")
Set MyRange = .Range(Range("A14"), .Range("A" & .Range("A" & .Rows.Count).End(xlUp).row))
End With
I have macro for copy one sample sheet. Numbers of sheets copies are based by different sheet values. I need insert different formulas for every copy to specific range, where row number of formula is elevated by +1. Is it possible to do this?
Example what I need:
- Sheet1 "=DATA_SELECTED!$N$2"
- Sheet2 "=DATA_SELECTED!$N$3"
- Sheet3 "=DATA_SELECTED!$N$4"
This is what I have right now without +1 in formulas.
Sub CopySheetsFromAList()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("DATA").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Set ws = Sheets("Sheet1")
For Each MyCell In MyRange
ws.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value
Sheets(Sheets.Count).Range("C3").Formula = "=DATA_SELECTED!$M$2"
Sheets(Sheets.Count).Range("C4").Formula = "=DATA_SELECTED!$N$2"
Sheets(Sheets.Count).Range("C6").Formula = "=DATA_SELECTED!$K$2"
Sheets(Sheets.Count).Range("C7").Formula = "=DATA_SELECTED!$Y$2"
Next MyCell
End Sub
maybe something like this
Option Explicit
Sub CopySheetsFromAList()
Dim MyCell As Range, MyRange As Range
Dim ws As Worksheet
Dim iRow As Long
Set MyRange = Sheets("DATA").Range("A1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Set ws = Sheets("Sheet1")
For Each MyCell In MyRange
ws.Copy after:=Sheets(Sheets.Count)
iRow = iRow + 1
With Sheets(Sheets.Count)
.Name = MyCell.Value
.Range("C3").Formula = "=DATA_SELECTED!$M$" & (1 + iRow)
.Range("C4").Formula = "=DATA_SELECTED!$N$" & (1 + iRow)
.Range("C6").Formula = "=DATA_SELECTED!$K$" & (1 + iRow)
.Range("C7").Formula = "=DATA_SELECTED!$Y$" & (1 + iRow)
End With
Next MyCell
End Sub
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
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
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.