I am working on the file where:
First, from a given list created a number of sheets with the names on the list (accounts)
Second, from the destination "Master" sheet, all the content should be copied to each of the new sheets
While I succeeded in creating a list of new sheets (thanks to this website), I am stuck with the content of each sheet. Do not know how to fill in each new sheet with identical content which is located in the sheet "Master". The sheet "Master" has certain format, formulas, and buttons so I need to make sure that each new sheet has exctly the same layout and content. Any suggestions how to incorporate it into below macro?
Sub CreateSheetsFromAList()
Application.ScreenUpdating = False
On Error GoTo ErrorHandler
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Cost Center").Range("A2")
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
Sheets("Instruction").Select
Range("A1").Select
ErrorHandler:
Sheets("Instruction").Select
Range("A1").Select
Exit Sub
Application.ScreenUpdating = True
End Sub
Your code is pretty close! To copy the contents of the "Master" sheet, replace
Sheets.Add After:=Sheets(Sheets.Count)
with
Sheets("Master").Copy After:=Sheets(Sheets.Count)
Trust this helps.
If the answer to my comment is yes, then you can try this:
Dim ws, new_ws as WorkSheet 'declare the worksheet
Set ws = Thisworkbook.Sheets("MasterSheet") 'set as mastersheet
For Each MyCell In MyRange
Set new_ws = ws.copy Before:=Thisworkbook.Sheets(1) 'creates a new worksheet
new_ws.Name = MyCell.Value 'rename it based on list
Next MyCell
Hope this helps.
Related
I'm trying to solve an issue i'm currently dealing with.
Below you'll find the issue:
I'm having multiple excel sheets that I'd like to merge into one file (located into different workbooks).
Each workbook consists out of the same sheets (SHEET1, SHEET2, SHEET3).
I'd like to merge all workbooks into 1 masterfile - and want to keep the same structure (SHEET1 = all date form all sheets).
So far I've manged to solve the merging issue with the below code:
Sub mergeFiles()
Dim numberOfFilesChosen, i As Integer
Dim tempFileDialog As FileDialog
Dim mainWorkbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet
Set mainWorkbook = Application.ActiveWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
tempFileDialog.AllowMultiSelect = True
numberOfFilesChosen = tempFileDialog.Show
For i = 1 To tempFileDialog.SelectedItems.Count
Workbooks.Open tempFileDialog.SelectedItems(i)
Set sourceWorkbook = ActiveWorkbook
For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Next tempWorkSheet
sourceWorkbook.Close
Next i
End Sub
I navigate via de Application.FileDialog to the folder with the different sheets. I select the files i want to merge, and then VBA does its job, and merges the files into one Excel sheet.
Hence some of the sheets are having the same name (=always) = SHEET 1, SHEET 2, SHEET 3, the merged sheets are having the same name with a figure behind (= SHEET1 (1), SHEET1 (2) ...)
I've managed to merge all the sheets into one worksheet, using the below code - but i can't mange to add a restriction to it - e.g. merge all the sheets starting with (SHEET1* into MASTERDATA SHEET1, SHEET2 * into MASTERDATA SHEET2, SHEET3 * into MASTERDATA SHEET3)
Sub Merge_Sheets()
Sheets.Add
ActiveSheet.Name = "MASTERDATA"
For Each ws In Worksheets
ws.Activate
If ws.Name <> "MASTERDATA" Then
ws.UsedRange.Select
Selection.Copy
Sheets("MASTERDATA").Activate
ActiveSheet.Range("A1048576").Select
Selection.End(xlUp).Select
If ActiveCell.Address <> "$A$1" Then
ActiveCell.Offset(1, 0).Select
End If
ActiveSheet.Paste
End If
Next
End Sub
Could any of you help me out + explain briefly the next step?
Kind Regards
D
You should check if the sheet name already exists in mainWorkbook. If it does append that data to the end of that sheet rather than insert a new worksheet. Therefore, you do not need to the second code
Try this (not tested and you might need to debug it, also note comments starting with '*)
Sub mergeFiles()
'* declare the type for each variable (no just at the end of the line)
'* always use Long if you're tempted to use Integer
Dim numberOfFilesChosen As Long, i As Long
Dim tempFileDialog As FileDialog
Dim mainWorkbook As Workbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet
'* declare the destination sheet
Dim destWorkSheet As Worksheet
Set mainWorkbook = ThisWorkbook ' Application.ActiveWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
tempFileDialog.AllowMultiSelect = True
numberOfFilesChosen = tempFileDialog.Show
For i = 1 To tempFileDialog.SelectedItems.Count
'* you can set sourceWorkbook directly here
Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i))
'Set sourceWorkbook = ActiveWorkbook
On Error Resume Next
For Each tempWorkSheet In sourceWorkbook.Worksheets
Set destWorkSheet = mainWorkbook.Sheets(tempWorkSheet.Name)
If Err.Number > 0 Then '* worksheet doesn't exist in mainWorkbook
tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Err.Clear
Else '* worksheet already exists
With tempWorkSheet.UsedRange
.Copy Destination:=destWorkSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'* If you only want to copy the values remove the above line and uncomment the below line
'destWorkSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End If
Next tempWorkSheet
On Error GoTo 0
sourceWorkbook.Close
Next i
End Sub
I would like to paste values from a range of cells in sheet1 into a specific range set in previously selected/activated sheets. Thus I want it to paste in let say only range B1 onwards but only for the sheets Sheet2, Sheet3 and NOT for Sheet4 since I have not selected it on my workbook.
Sub CopyFirstRow()
Dim Wb As Workbook
Dim Sht As Worksheet
Dim mySelectedSheets As Sheets
Wb.Sheets("Global").Range("B1", "Q39").Copy
Set mySelectedSheets = ActiveWindow.SelectedSheets
For Each Sht In mySelectedSheets
ActiveSheet.Paste
Sht.Range("B1").PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False
End With
End With
End Sub
Please explain what I am doing wrong, as I am trying to understand more and more VBA and specifically the SET, FOR, WITH functions.
You dim'd the wb but never set the workbook.
You have two "End With"'s but have no starting "With"'s
.
You have Activesheet.paste but have not selected a sheet
Sub Button1_Click()
Dim Wb As Workbook
Dim Sht As Worksheet
Dim mySelectedSheets As Sheets
Set Wb = ThisWorkbook
Wb.Sheets("Global").Range("B1", "Q39").Copy
Set mySelectedSheets = ActiveWindow.SelectedSheets
For Each Sht In mySelectedSheets
Sht.Range("B1").PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False
End Sub
Fellow VBA Wizards,
Using the following code, I was able to generate multiple sheets with tab names equal to a dynamic range:
Sub SheetMacro()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Control_Sheet").Range("F7")
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
I'm running into a bit of a snag when attempting to copy a source template w/formulas (EAC Summary) into all recently created sheets. Adding this code duplicates the EAC Summary, but it does not name the tabs within the dynamic range:
Sub SheetMacro()
Dim MyCell As Range, MyRange As Range
Dim ws1 As Worksheet
Set MyRange = Sheets("Control_Sheet").Range("F7")
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
Set ws1 = ThisWorkbook.Worksheets("EAC Summary")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
Next MyCell
End Sub
Is there an optimal method to combine the code in such a way to replicate the source template, and name the tabs according to inputs in the dynamic range?
Thanks in advance.
I was able utilize an alternative command for copying, which resolved my initial question. Here is the code, for anyone that may run into this going forward:
Sub SheetMacro3()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Control_Sheet").Range("F7")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Sheets("EAC Summary").Visible = True 'displays master template
For Each MyCell In MyRange
Sheets("EAC Summary").Copy After:=Worksheets(Worksheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
Sheets("EAC Summary").Visible = False 'hides master template
End Sub
HI I have created a VBA that takes info from a ALL data sheet and plots it in worksheets.
The worksheets get automatically generated which is great but the issue is that VBA is only supposed to create Unique worksheets - however this is not the case.
Example: if in my ALL data sheet I have IKEA 3 times then the first time the vba encounters IKEA then it should create a worksheet while it should ignore any repeats.
Actual
IKEA; Sheet 2 ; Sheet 3
Wanted
IKEA
VBA Code
Sub CreateSheetsFromAList()
Dim iReply As Integer
Dim MyCell As Range, MyRange As Range
On Error Resume Next
Range("B1").End(xlUp).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True
Set MyRange = Sheets("ALL").Range("B1")
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
Try this code (it creates new sheet only if there is no sheets with name MyCell.Value):
Sub CreateSheetsFromAList()
Dim iReply As Integer
Dim MyCell As Range, MyRange As Range
Dim sh as Worksheet
On Error Resume Next
Range("B1").End(xlUp).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True
Set MyRange = Sheets("ALL").Range("B1")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Set sh = Nothing
Set sh=Sheets(MyCell.Value)
If sh is Nothing Then
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
End If
Next MyCell
End Sub
I want to create worksheets from a list of "projects" from a master worksheet. When a worksheet is created I want it to be renamed as the project number from the list.
I found two macros that do the job but I need them to work together.
This one creates tabs and renames them.
Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Invoice Summary").Range("B11")
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
This one copies master tab and creates another worksheet.
Sub Test()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Master")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub
Assuming there is no worksheet named "Master (2)" in your workbook, this code should work:
Sub CreateSheetsFromAList()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Master")
Dim MyCell As Range, MyRange As Range
Set MyRange = Sheets("Invoice Summary").Range("B11")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
ThisWorkbook.Worksheets("Master (2)").Name = MyCell.Value
Next MyCell
End Sub
It does seem odd that there is no worksheet object returned from the Worksheet.Copy method.
One thing to note when using xlDown to get the end range -- if you have zero cells or one cell in your range, xlDown will extend all the way to the last row of the worksheet, which will produce undesirable behavior. In this case, you'll get an error when attempting to rename the target sheet, but it is something to look out for.