Need a VBA code. rename sheets from list
I have a list of names in sheet 2 cell w3 thru w22. I need to name sheets/tabs 3 thur 22 from the the list of names. The names change.
and if no name in w3 thru w22. I want the tabs to be numbered 1 thru 20
Any Ideas?
Dim MyCell As Range, MyRange As Range, Dim i As Integer
Set MyRange = Sheets("Summary").Range("w3")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
If MyCell.Value IS NULL
Sheets(Sheets.Count + 3).Name = i
Sheets(Sheets.Count + 3).Name = MyCell.Value ' renames the new worksheet
Next MyCell
Or something like this maybe, I didn't test it since you didn't give us anything to go off of or make any effort to solve it yourself.
http://en.kioskea.net/faq/27361-excel-a-macro-to-create-and-name-worksheets-based-on-a-list Kudos to this website for giving me a basis to go off of.
Related
can you please help me with a vlookup in a different sheet only for certain values?
I have tried for each, for i, different if's and so on.
I need the vba to bring in Sheet2 values from a Sheet1, but only for rows that have the value "De rediscutat" in a different column in Sheet2.
Below you have the code i wrote for this function:
Dim result As String
Dim Sheet2 As Worksheet
Set Sheet2 = ActiveWorkbook.Sheets("Sheet2")
Set MyRange = Range("X2:X800")
If MyRange = "De rediscutat" Then
Worksheets("Sheet2").Range("N2:N694").Formula = Application.WorksheetFunction.VLookup(Sheet2.Range("I2:I694"), Sheet1.Range("G2:M500"), 7, False)
End If
End Sub```
Thanks!
You will need a loop to do this. Your code also has much redundancy. This will hopefully get you started:
Dim cel As Range, myrange As Range
Set myrange = Sheet2.Range("X2:X800")
For Each cel In myrange
If cel.Value = "De rediscutat" Then
'Grab whichever value you need and put it where you need it
End if
next cel
I suggest using Cel.Row to get the row number of the current cell in the loop, or Cel.Offset(,) to get to a cell on the same row.
For Each and For i will both work for looping through MyRange but you have not included either in your code.
The problem may not have been your loop, but rather the way you test the cell. If MyRange = "De rediscutat" will only work when MyRange` is a single cell.
If you Dim cell As Range recreate a For Each cell In MyRange loop and use `If cell = "De rediscutat" then it should work.
Im wondering how i could create an Excel VBA that makes new Sheets and takes the names from a column with the range A2:A100 and only creates sheets if these cells arent empty.
My Sheet with the names looks something like this :
Variant | Title | Number
V1 Test1 1.1
V2 Test2 2.1
This means, that new Sheets with the names V1 & V2 should be created.
Furthermore i would want them, if possible, to have the exact same Content
A1 : productnumber A2 : amount
EDIT
Used this code now in Order to create the Sheets :
Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Summary").Range("A10")
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
Changed "Summary" to my Sheets Name and adjusted the Range. As mentioned, i want the file to create Sheets based on the cell contents of A2:A100 only if the cell contains anything at all. Furthermore i am still not able to set the Contents of the new Sheets that are created
You have the basic method nailed, just added a check that the cell contains something and used a worksheet variable for the new sheet which is easier to use if you need to do things to it.
I don't know what you mean when you say you are "not able to set the Contents of the new Sheets"?
Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range, ws As Worksheet
Set MyRange = Sheets("Summary").Range("A2:A100")
For Each MyCell In MyRange
If Len(MyCell) > 0 Then
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'creates a new worksheet
ws.Name = MyCell.Value ' renames the new worksheet
ws.Range("A1:D1").Value = Array("Artikelnummer", "Menge pro Schrank", "Anzahl Schränke", "Menge Gesamt")
End If
Next MyCell
End Sub
I am facing trouble while developing code for creating multiple sheets and the sheet names are taken from the list in other sheet and then in the created sheets, there are some fields needs to be updated from the table. I mean first created sheet, value to copied from main sheet cell A1 (for example), and next created sheet, value to copied from main sheet cell A2 and goes till end.
I developed code until its successfully copies it but I have no idea how to replace cell values from the table.
I dont knw how much challenging it is but any help would be greatly appreciated.
Thanks
Sarath
My current code
Sub create_sheets()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("input data").Range("C6")
Set MyRange = Range(MyRange, MyRange.End(xlToRight))
For Each MyCell In MyRange
Sheets("200L_50°C").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
End Sub
First, this
Set MyRange = Sheets("input data").Range("C6")
Set MyRange = Range(MyRange, MyRange.End(xlToRight))
can be done in one line:
Set MyRange = Range(Cells(6, 3), Cells(6, 3).End(xlToRight))
Also consider more robust version:
Set MyRange = Range(Cells(6, 3), Cells(6, Columns.Count).End(xlToLeft))
Having settled this, to create sheets I would rather use .Add method:
Dim i As Long: i = 1
For Each MyCell in MyRange
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value
'copy the value from main Worksheet - from A1, A2, etc.
'to A1 in new worksheet - it remains first sheet I assume
Sheets(Sheets.Count).Cells(1, 1).Value = Sheets(1).Cells(i, 1).Value
i = i + 1
Next MyCell
Also, using Sheet(1) is unnecessary, since we don't activate or select any other sheet.
I hope you can help. I have a piece of code below, and its working somewhat. I just need it to do more.
It currently looks along the first row from A1 to H1. If it finds a blank cell then it copies the cell value to the left of the blank cell, then pastes this value into the blank cell and then moves along.
As the range can change from day to day A1 to H1 will not suffice. I now need the code to look along the first row, until it finds the last cell with data in it then look for the blanks and start the copy and paste process.
I also need the code to then add a 2 to the pasted cell so that I can perform a pivot and differentiate between the copied cells and the pasted.
I have provided a picture below for better understanding. The end result should be that cell B2 contains the text 24 - Company: Hier 2 and E2 contains the text 07 - Product: Family Hier 2
My code is below and as always any and all help is greatly appreciated.
Pic 1
MY CODE
Public Sub BorderForNonEmpty()
Dim myRange As Range
Set myRange = Sheet1.Range("A1:H1")
For Each MyCell In myRange
If MyCell.Text = "" Then
MyCell.Offset(0, -1).Select
ActiveCell.Copy
ActiveCell.Offset(0, 1).PasteSpecial (xlPasteAll)
End If
Next
End Sub
Try the code below - the comments indicate what each important line is doing:
Option Explicit
Sub FillInHeaders()
Dim ws As Worksheet
Dim lngRowWithHeaders As Long
Dim rngHeader As Range
Dim rngCell As Range
' get a reference to your worksheet
Set ws = ThisWorkbook.Worksheets("SHeet1")
' set the row that the headers are on
lngRowWithHeaders = 2
' get the range from A1 to ??1 where ?? is last column
Set rngHeader = ws.Cells(lngRowWithHeaders, 1) _
.Resize(1, ws.Cells(lngRowWithHeaders, ws.Columns.Count) _
.End(xlToLeft).Column)
' iterate the range and look for blanks
For Each rngCell In rngHeader
' if blank then ...
If IsEmpty(rngCell.Value) Then
' get cell value from left and a 2
rngCell.Value = rngCell.Offset(0, -1).Value & "2"
End If
Next rngCell
End Sub
I found and altered simple code to create new sheets from a master and name the sheets from the range. The code is below and works without error.
I would like to include an adjacent range (A11) in the code that will determine that the new/copied sheet will be created using MasterReport or MasterReport2 as the copy from. If range A11 has a "P" I would like the new sheet to be copied from MasterReport and if range A11 contains an "S" the new sheet to be copied will be from MasterReport2. MasterReport and MasterReport2 are hidden sheets.
Most likely need to identify a second range and use IfElse but where within the current code should this go. Would like to maintain that the new sheet names will reflect range C11 values.
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("ProjectDefinition").Range("c11")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets("MasterReport").Select
ActiveSheet.Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value
Next MyCell
There are a number of methods to get your optional termplate worksheet but I believe a Select Case statement will offer the best expandability.
Dim myCell As Range, strWSname As String
With Sheets("ProjectDefinition")
For Each myCell In .Range(.Range("C11"), .Range("C11").End(xlDown))
Select Case UCase(myCell.Offset(0, -2))
Case "S"
strWSname = "MasterReport2"
Case "P"
strWSname = "MasterReport"
Case Else
strWSname = "MasterReport" 'default
End Select
Sheets(strWSname).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = myCell.Value
Next myCell
End With