I have an excel template (//desktop/spellTemplate.xltx) Now I have a worksheet open with a list of names starting at A2 and a description at A3
A2 A3
Imp does 5 damage
death does 3 damage
ghost heals 5 life.
The list is quite long and i need to do two things with this list.
First how can i create a new worksheet (in this workbook) for each of the items in the A2 collumn, with the worksheet named after the item.I
Now when it creates the new worksheet, I want it to use the template i created above.
Then put the name A2 into the templates cell A1 and the descriptionA3 into the templates cell C1. How can I can do this all automatically for the list of names?
I assumed your list looks like the following and is on a sheet named Spells:
Try running this code by changing the path to the location of your template file:
Sub createSheet()
Dim rng As Range
Set rng = Sheets("Spells").Range("A2:A4")
Dim wks As Worksheet
For Each cell In rng
On Error Resume Next
If cell.Value <> "" Then
Set wks = Sheets.Add(After:=Worksheets(Worksheets.Count), Type:="C:\Users\PortlandRunner\AppData\Roaming\Microsoft\Templates\spellTemplate.xltx")
wks.Name = cell.Value
wks.Range("A1").Value = cell.Value
wks.Range("C1").Value = cell.Offset(0, 1).Value
End If
Next cell
End Sub
The On Error Resume Next line will skip sheets that already exist.
Resulting sheets created:
Related
I have the following Problem:
I have two (dynamic) lists that are named MarketsEquities and MarketsBonds and are found on worksheets SummaryEquities and SummaryBonds, respectively.
I then have a worksheet named PnL where I want to create a list of the markets listed in the previous worksheets. These Markets should all be listed in column C and a space should be provided between the end of the equities list and the start of the bond list, wherein I shall write in column B Bonds.
This is what I've got thus far:
Sub InsertEquitiesBonds()
Dim ws As Worksheet, r1 As Range, r2 As Range
Set ws = Worksheets("PnL")
ws.Activate
Set Range("B3").Value = "Equities"
Set r1 = Worksheets("SummaryEquities").Range("MarketsEquities")
r1.Copy Range("C4")
'I want to then insert "Bonds" in Column B at the end of the listing of equities and then list all bonds in column C below that.
Set r2 = Worksheets("SummaryBonds").Range("MarketsBonds")
End Sub
Help is greatly appreciated.
I recommend to specify a worksheet for every Range() or Cells() statement like ws.Range("C4") otherwise Excel guesses which worksheet you mean.
You can determine the last used cell in a column with
ws.Cells(ws.Rows.Count, "B").End(xlUp) 'last used cell in column B
and you can use .Offset(row, column) to move rows/columns relatively from that cell.
So I suggest the following:
Public Sub InsertEquitiesBonds()
Dim ws As Worksheet
Set ws = Worksheets("PnL")
ws.Range("B3").Value = "Equities"
Worksheets("SummaryEquities").Range("MarketsEquities").Copy ws.Range("C4")
Dim LastUsedCell As Range
Set LastUsedCell = ws.Cells(ws.Rows.Count, "B").End(xlUp) 'last used cell in column B
LastUsedCell.Offset(2, 0).Value = "Bonds" 'move 2 cells down and write Bonds
Worksheets("SummaryBonds").Range("MarketsBonds").Copy LastUsedCell.Offset(3, 1) 'copy MarketsBonds 3 cells down and one cell right of the last used cell
End Sub
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 include some code in my project and I have something I do not understand. My With loop doesn't works.
My goal is to create new sheet from a specific cell B16=House and other new sheet for each cells contains PRIVATE word.
Example:
When user click on button:
- One new sheet created with title=Value of B16 just after my first sheet (name MyFirstSheet)
- Some other sheets created for each cells values contains word PRIVATE, just after the previous sheet.
So the result will be MyFirstSheet, House, Test1PRIVATE, Test2PRIVATE....
Sub NewSheetFromTemplate()
Dim SearchRange As Range, c As Range
Dim sht As Worksheet
'New sheet for a specific cell
Sheets("TEMPLATE").Copy After:=Sheets("MyFirstSheet")
ActiveSheet.Name = Sheets("MyFirstSheet").Range("B16").Value
'New sheet for each cell contains PRIVATE
With ThiwWorkbook
Set SearchRange = ActiveSheet.Range("B16:D70")
For Each c In SearchRange
If Right(c.Value, 2) = "PRIVATE" Then
Sheets("TEMPLATE").Copy After:=Sheets("MyFirstSheet")
Sheets("MyFirstSheet").Name = c.Value
End If
Next c
End With
End Sub
The problem is: My first sheet is well created (so i have MyFirstSheet, House, created) but not others sheet for each cell contains "PRIVATE"
Excel say ERROR 1004, and created a sheet in title TEMPLATE (2)
If I understand the question correctly then you merely need to change the line
If Right(c.Value, 2) = "PRIVATE" Then
to
If UCase(Right(c.Value, 7)) = "PRIVATE" Then
That's because the length of the word "private" is 7 characters and not 2. Furthermore, I am using UCASE to ensure that it will also find a match if private is written with different caps.
Thank you #Fabrizio and #Ralph for your assistance and explanation.
My final code:
Sub NewSheetFromTemplate()
Dim SearchRange As Range, c As Range
Dim sht As Worksheet
'New sheet for each value contain "PRIVATE"
With ThiwWorkbook
Sheets(1).Select
Set SearchRange = ActiveSheet.Range("A2:C70")
For Each c In SearchRange
If Right(c.Value, 7) = "PRIVATE" Then
Sheets("TEMPLATE").Copy After:=ActiveSheet
ActiveSheet.Name = c.Value
End If
Next c
End With
'New sheet for a specific cell: A2
Sheets(1).Select
Sheets("TEMPLATE").Copy After:=ActiveSheet
ActiveSheet.Name = Sheets(1).Range("A2").Value
'Show OK message
Sheets(1).Select
MsgBox "OK, all sheets well created. Please fill out next sheet"
End Sub
I have a workbook with multiple sheets. One sheet has 2 columns of data. This sheet is titled "Notes" while the rest of them have a title that matches values entered in range A1:A6 of the "Notes" sheet. Column B contains notes that must go on each respective sheet from column A.
For example, if the 2nd sheet in the workbook is titled "Gpu manufacturing" and the value in A1 of the "Notes" sheet is also "Gpu manufacturing," then I want value in cell B1 of the "Notes" to be entered into cell F1 of the "Gpu manufacturing" sheet.
Next, if the 3rd sheet in the workbook is titled "Tesla GPUs" and the value in A2 of the "Notes" sheet is also "Tesla GPUs," then I want value in cell B2 of the "Notes" to be entered into cell F1 of the "Tesla GPUs" sheet.
Rinse and repeat to keep pulling data from the "Notes" sheet into other sheets based on their name or title.
Here is what I have so far:
Sub example()
Dim wkSht As Worksheet
For Each wkSht In Sheets
For Each Cell In Sheets("Reporting").Range("B2:B200")
If Cell.Value = wkSht.Name Then
wkSht.Range("D15").Copy Destination:=Cell.Offset(0,1)
End If
Next Cell
Next wkSht
End Sub
Edit for BruceWayne:
this is what my VBA app shows:
You first wrote:
"For example, if the 2nd sheet in the WB is titled "Gpu manufacturing" and the value in A1 of the "Notes" sheet is also "Gpu manufacturing," then I want value in cell B1 of the "Notes" to be entered into cell F1 of the "Gpu manufacturing" sheet."
From which it derives the following code:
Sub Main()
Dim cell As Range
For Each cell In Worksheets("Notes").Range("A1:A6")
Worksheets(cell.Value).Range("F1") = cell.Offset(,1)
Next cell
End Sub
Then you wrote in a comment to BruceWayne answer:
"however it still does not return anything in the F2 cell of each sheet"
Which changes (from "F1" to "F2") the destination cell in sheets other than "Notes" where to paste its values from column "B"
Should this latter be the real case then just substitute:
Worksheets(cell.Value).Range("F1") = cell.Offset(,1)
with:
Worksheets(cell.Value).Range("F2") = cell.Offset(,1)
Finally you wrote in another comment to BruceWayne answer:
"this is just a test workbook to get a macro that works because in reality, i will need to use it on a workbook that has 700+ sheets to match to a column and return specific data for that sheet from the second column on the "Notes" sheet – William Crawford 1 hour ago"
Which is an entirely different thing
My code here answers your original question
Should your need have changed than post another question
Sub example()
Dim wkSht As Worksheet
Dim cel As Range
For Each wkSht In ActiveWorkbook.Worksheets
For Each cel In Sheets("Reporting").Range("B2:B200")
If cel.Value = wkSht.Name Then
wkSht.Range("D15").Copy Destination:=cel.Offset(0, 1)
End If
Next cel
Next wkSht
End Sub
Mainly, I added Acitveworkbook.Worksheets instead of just Sheets. This should make sure the active book is the one being run on. Also, make sure you have a sheet called "Reporting". If this doesn't work, let me know how so.
Also realize, it's going to loop through 200 cells, on each worksheet. Is that the most efficient way to do this? Are you doing that big loop because the value is somewhere in that range? Or you actually need to check each one? (I'm thinking a find might be better)
Edit: How's this one, I switched it after your comments:
Sub example2()
Dim wkSht As Worksheet
Dim cel As Range
Dim curShtName As String
For Each sht In ActiveWorkbook.Worksheets
sht.Name = Trim(sht.Name)
Next sht
For i = 1 To 6 ' Since we go from A1/B1 to A6/B6
curShtName = Worksheets("Notes").Cells(i, 1).Value
If curShtName <> "Notes" Then
Worksheets(curShtName).Cells(2, 6).Value = Worksheets("Notes").Cells(i, 2).Value
End If
Next i
End Sub
Edit: just realized this is basically what user3598756 did :P
Edit 3: Okay, first, make positive that the second code bit I added above is in a workbook module in the workbook with your sheets. This should work for you, it did for me:
Then after running it:
etc, etc.
Per your most recent comments:
Sub copyInfo()
Dim lastRow As Long
Dim notesWS As Worksheet
Set notesWS = ActiveWorkbook.Worksheets("Notes") ' This is the worksheet with the info. you want to copy over to other sheets
lastRow = notesWS.Cells(notesWS.Rows.Count, 2).End(xlUp).Row ' Assuming your Col. B has the most info
Dim myFacts() As Variant
myFacts = notesWS.Range(notesWS.Cells(1, 2), notesWS.Cells(lastRow, 2))
Dim i As Long
i = 1
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Notes" Then
ws.Cells(2, 6).Value = myFacts(i, 1) 'This loops through our Array that we created above.
i = i + 1
End If
Next ws
End Sub
I have a file named vegetables_fruits and 4 other files : apple, banana, tomato, cucumber. In the file vegetables_fruits I have a Worksheet named List where I fold the names of all 4 files (ex., cell A2 = apple, cell A3 = banana, cell A4 = tomato, cell A5 = cucumber). In addition to the sheet List I have sheets banana, tomato and cucumber, but I don't have apple.
It's necessary to paste the column A from each of this 4 files to every sheet in the vegetables_fruits (ex., from file apple it's necessary to copy column A to file "vegetables_fruits" to sheet "banane" ; from file "banana" it's necessary to copy column A to file vegetables_fruits to sheet tomato etc.) Thank you very much for your help!
P.S. It needs to create a For, but I don't know how I can decribe all of this conditions.
Sub CopyPaste()
Dim r As Variant
Dim a As Variant
Dim b As Integer
Dim nbcells As Integer
Dim ws As Worksheet
Worksheets("List").Activate
nbcells = Application.WorksheetFunction.CountA(Range("A2:A" & Range("A65536").End(xlUp).Row))
' === Create a new sheet ===
For r = 2 To nbcells
Sheets.Add After:=Sheets(Sheets.Count - 1)
Worksheets(r).Name = Worksheets("List").Cells(r + 1, 1).Value
Next r
' === DATA ===
For Each ws In Sheets
If ws.Name Like "*.xls*" Then
For a = 2 To nbcells
Windows(a).Activate
Range("B:B").SpecialCells(2).Copy
Workbooks("vegetables_fruits.xlsm").Activate
b = a + 1
If ws.Name = Worksheets("List").Cells(b, 1).Value Then
ws.Select
Range("A2").Select
ActiveSheet.Paste
End If
Next a
End If
Next
End Sub
Maria - Reading your question, I think the additional logic you need is as follows:
Assume all workbooks are open, and have the appropriate name.
Loop through all of the workbooks.
If I find a workbook with one of my defined names, then copy Column A from (some sheet) in that workbook
Paste this into the master workbook, on the sheet with the corresponding name.
For my example, you would need to add these variables in the section where the variables are declared.
Dim fromWS As Worksheet, toWS As Worksheet
Dim wb As Workbook, myWB As Workbook
Early in the code, near the top, you will need this line of code.
Set myWB = ActiveWorkbook
Later in the code, this Loop and Case statements will accomplish the above logic ...
For Each wb In Workbooks
Select Case wb.Name
Case "apple"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("apple")
Case "banana"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("banana")
Case "tomato"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("tomato")
Case "cucumber"
Set fromWS = wb.Worksheets("Sheet1") '<~~ put your sheet name here
Set toWS = myWB.Worksheets("cucumber")
Case Else
End Select
fromWS.Range("A:A").Copy toWS.Range("A:A")
Next wb
You talk about there not being an "apple" sheet. This is a nuance you may need to build exception logic for. (e.g. just omit that case in the above loop)