I can create a workbook that contains a single worksheet using the following code:
'Create Custom Excel Report
Set XL = New Excel.Application
XL.Visible = True
Set WB = XL.Workbooks.Add
Set WKS = WB.Worksheets(1)
WKS.Name = "Fred"
'Set Report Headers
WKS.Cells(2, 1).value = "Name"
WKS.Cells(2, 2).value = "Address"
WKS.Cells(2, 3).value = "Hat Size"
How can I create a workbook that has 3 worksheets? How do I set the values for the individual worksheets?
The workbook starts with one sheet. You can append a sheet and name it via a line like this:
WB.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Fred"
You can assign a variable on creation, or you can reference the new sheet be name: E.g., WB.Sheets("Fred")
Related
I am still very new to VBA and am trying to combine certain worksheets from different workbooks.
For example:
I have a workbook called "One" with multiple worksheets (A,B,C,D).
I have another workbook called "Two" with multiple worksheets (E,F,G,H).
I want to take worksheet A from workbook One and worksheets F and G from workbook Two. I wish to put these different worksheets in a new workbook called "Three."
My fields in worksheets A and F are in the exact same format, so I also wish to combine these two worksheets and put F data in the same fields under the A data, as soon as my cells containing A data finishes.
Could anyone help me with this code??
If anyone also has any links to VBA for beginners that would be highly appreciated.
Take a look at example:
'enforce declaration of variables
Option Explicit
Sub CombineWorkbooks()
Dim sWbkOne As String, sWbkTwo As String
Dim wbkOne As Workbook, wbkTwo As Workbook, wbkThree As Workbook
Dim wshSrc As Worksheet, wshDst As Worksheet
On Error GoTo Err_CombineWorkbooks
'get the path
sWbkOne = GetWbkPath("Open workbook 'One'")
sWbkTwo = GetWbkPath("Open workbook 'Two'")
'in case of "Cancel"
If sWbkOne = "" Or sWbkTwo = "" Then
MsgBox "You have to open two workbooks to be able to continue...", vbInformation, "Information"
GoTo Exit_CombineWorkbooks
End If
'open workbooks: 'One' and 'Two'
Set wbkOne = Workbooks.Open(sWbkOne)
Set wbkTwo = Workbooks.Open(sWbkTwo)
'create new one - destination workbook
Set wbkThree = Workbooks.Add
'define destination worksheet
Set wshDst = wbkThree.Worksheets(1)
'start copying worksheets
'A
Set wshSrc = wbkOne.Worksheets("A")
wshSrc.UsedRange.Copy wshDst.Range("A1")
'F
Set wshSrc = wbkTwo.Worksheets("F")
wshSrc.UsedRange.Copy wshDst.Range("A1").End(xlDown)
'G
Set wshSrc = wbkTwo.Worksheets("G")
wshSrc.UsedRange.Copy wshDst.Range("A1").End(xlDown)
'done!
Exit_CombineWorkbooks:
On Error Resume Next
Set wbkThree = Nothing
If Not wbkTwo Is Nothing Then wbkTwo.Close SaveChanges:=False
Set wbkTwo = Nothing
If Not wbkOne Is Nothing Then wbkOne.Close SaveChanges:=False
Set wbkOne = Nothing
Set wshDst = Nothing
Set wshSrc = Nothing
Exit Sub
Err_CombineWorkbooks:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_CombineWorkbooks
End Sub
Function GetWbkPath(ByVal initialTitle) As String
Dim retVal As Variant
retVal = Application.GetOpenFilename("Excel files(*.xlsx),*.xlsx", 0, initialTitle, , False)
If CStr(retVal) = CStr(False) Then retVal = ""
GetWbkPath = retVal
End Function
Note: Above code has been written ad-hoc, so it may not be perfect.
[EDIT2]
If you would like to copy data into different sheets, please, replace corresponding code with below, but firstly remove these lines:
'define destination worksheet
Set wshDst = wbkThree.Worksheets(1)
later:
'start copying data
'A
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "A"
Set wshSrc = wbkOne.Worksheets("A")
wshSrc.UsedRange.Copy wshDst.Range("A1")
'F
Set wshSrc = wbkTwo.Worksheets("F")
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "F"
wshSrc.UsedRange.Copy wshDst.Range("A1")
'G
Set wshSrc = wbkTwo.Worksheets("G")
Set wshDst = wbkThree.Worksheets.Add(After:=wbkThree.Worksheets(wbkThree.Worksheets.Count))
wshDst.Name = "G"
wshSrc.UsedRange.Copy wshDst.Range("A1")
Good luck!
So I have a dashboard sheet named "Business Plans" where I have a dropdown in cell A2 that's a dropdown selection of a range called "Facilities" and all dashboard data are driven off of lookups. What I want to do is First create a new workbook than a new tab for each dropdown selection with the tab in the same format but the data pasted as values. I attempted the following code that I created to save every dropdown selection as PDF but I have been unsuccessful. Any insight on how I can get this code working will be great.
Sub Worksheet_Generator()
Dim cell As Range
Dim wsSummary As Worksheet
Dim counter As Long
Set wsSummary = Sheets("Business Plans")
For Each cell In Worksheets("dd").Range("$C3:$C75")
If cell.Value = "" Then
counter = counter + 1
Application.StatusBar = "Processing file: " & counter & "/1042"
Else
counter = counter + 1
Application.StatusBar = "Processing file: " & counter & "/1042"
With wsSummary
.Range("$A$2").Value = cell.Value
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
End With
End If
Next cell
Set wsSummary = Nothing
End Sub
I think you are looking for something like the below (adapted from copying-dynamic-rows-into-new-workbook-and-save-it).
Option Explicit
Sub grabber()
Dim thisWb As Workbook: Set thisWb = ThisWorkbook
Dim thisWs As Worksheet: Set thisWs = thisWb.Worksheets("dd") 'replace with relevant name
Dim newBook As Workbook
Dim newws As Worksheet
Dim pathToNewWb As String
Dim uKeys
Dim currentPath, columnWithKey, numCols, numRows, uKey, dataStartRow, columnKeyName
'nobody likes flickering screens
Application.ScreenUpdating = False
'remove any filter applied to the data
thisWs.AutoFilterMode = False
'get the path of the workbook folder
currentPath = Application.ThisWorkbook.Path
'Set the stage
'###Hardcode###
columnKeyName = "Facility" 'name of the column with the facility values
dataStartRow = 4 'this is a pure guess, correct as relevenat. Use the header row index
pathToNewWb = currentPath & "/Business Plans.xlsx" ' where to put the new excel, if you want a saveas prompt you should google "Application.FileDialog(msoFileDialogSaveAs)"
uKeys = Range("Facilities").Value
'###Hardcode End###
columnWithKey = thisWs.Range(dataStartRow & ":" & dataStartRow).Find(what:=columnKeyName, LookIn:=xlValues).Column
numCols = thisWs.UsedRange.Columns.Count
'extract the index of the last used row in the worksheet
numRows = thisWs.UsedRange.Rows.Count
'create the new workbook
Set newBook = Workbooks.Add
'loop the facilities, and do the work
For Each uKey In uKeys
'Filter the keys column for a unique key
thisWs.Range(thisWs.Cells(dataStartRow, 1), thisWs.Cells(numRows, numCols)).AutoFilter field:=columnWithKey, Criteria1:=uKey
'copy the sheet
thisWs.UsedRange.Copy
'Create a new ws for the facility, and paste as values
Set newws = newBook.Worksheets.Add
With newws
.Name = uKey 'I assume the name of the facility is the relevant sheet name
.Range("A1").PasteSpecial xlPasteValues
End With
'remove autofilter (paranoid parrot)
thisWs.AutoFilterMode = False
Next uKey
'save the new workbook
newBook.SaveAs pathToNewWb
newBook.Close
End Sub
EDIT:
As I have not seen your data, I would not be surprised if it requires some revision.
First I try to "frame" the range of the worksheet "dd" that contains the data (the ###Hardcode### bit), define the path for the output, and identify the column that can be filtered for the values corresponding to the named range "Facilities".
I retrieve the values of the named range "Facilities" (into uKeys), and create the output workbook (newBook). Then we go through each value (uKey) from the uKeys in the for loop. Within the loop, I apply an autofilter for the uKey. The filtration is followed by creation of a sheet (newWs) in newBook, and a copy paste of the filtered worksheet "dd" into newWs. we then turn off the autofilter, and the worksheet "dd" is returned to its unfiltered state.
At the end we save newBook to the desired location, and close it.
Trying to complete a VBA routine for the first time.
The goal is :
Use a vertical range of cell that have different names in each cell to create multiples worksheets in one new workbook.
Here's what i got until now :
Sub AddWorksheet()
Dim plage As Range
Dim i As Integer
Dim titre As String
Dim wb As Workbook
Set plage = Range("E6:E24")
Set wb = Workbooks.Add("New Workbook")
For i = 1 To plage.Height
If plage.Cells(i).Value <> "" Then
titre = plage.Cells(i).Value
ActiveWorkbook.Sheets("FeuilleTemplate").Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Sheets(wb.Sheets.Count).Activate
ActiveSheet.Name = titre
End If
Next i
End Sub
Until now the following line is giving me a hard time :
Set wb = Workbooks.add("New Worbook")
The error message is : Error execution '1004' :
The method 'dd' of the object 'Workbooks' has failed.
I'm having a hard time reading and finding the info too for how the methods and class works
I'm use to java.
Thanx for those who gona take time to help me thru this
I think we cannot add a workbook with a specified name as it is not yet saved. So just add workbook do all the operations and in the end save it with the desired name.
Sub AddWorksheet()
Application.DefaultSaveFormat = xlOpenXMLWorkbook
Dim plage As Range
Dim i As Integer
Dim OldBook As Workbook, NewBook As Workbook 'declare both workbooks
Set OldBook = ActiveWorkbook
spath = ThisWorkbook.Path
Set plage = OldBook.Sheets("Sheet Names").Range("E6:E24") 'Assuming that sheet names are in range E6:E24 in "Sheet Names" sheet in old workbook
Set NewBook = Workbooks.Add 'adding new workbook so as to copy the template sheet but this workbook is not saved yet
For i = 1 To plage.Height
If plage.Cells(i).Value <> "" Then 'for each non blank cell in range
OldBook.Sheets("FeuilleTemplate").Copy After:=NewBook.Sheets(NewBook.Sheets.Count) 'Copy "FeuilleTemplate" sheet in workbook after last sheet
NewBook.Sheets("FeuilleTemplate").Name = plage.Cells(i).Value 'Rename the sheet to the desired names from range E6:E24 in "Sheet Names" sheet in old workbook
End If
Next i
With NewBook
.SaveAs Filename:=spath & "\" & "New Workbook with Templates"
.Close SaveChanges:=True
End With
End Sub
I would like to be able to
take a sheet called "data" in a given workbook called
"original_data.xlsm",
copy it conditionally (using Autofilter or
something else), say only those rows where column C was "dog"
Create a new workbook, in the same folder as the original book, called dog.xlsm and save the copied stuff into
a new sheet called "dog data".
Then repeat with a different filter.So for example copy and
autofilter if column C was "cat" and create a workbook "cat.xlsm", in the same folder as the original book, with a sheet called "cat_data" containing some filtered data.
I've been making incorrect attempts for three days now and would appreciate some help. Here is what I have done so far.
Workbooks.Add
Set wb = ActiveWorkbook
GetBook = ActiveWorkbook.Name
wb.Sheets("data").SaveAs Workbooks(GetBook).Path & "\dog"
Workbooks("dog.xlsx").Worksheets("Sheet1").UsedRange.AutoFilter Field:=3, Criteria1:="=dog"
But it's not working. :(
Looks like you're trying to set wb to "original_data.xlsm", but your first line is making the new workbook the active workbook.
Workbooks.Add
Set wb = ActiveWorkbook
See if this helps.
Sub sheetCopy()
Dim wbS As Workbook, wbT As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Set wbS = ThisWorkbook 'workbook that holds this code
Set wsS = wbS.Worksheets("Data")
wsS.Copy
Set wbT = ActiveWorkbook 'assign reference asap
Set wsT = wbT.Worksheets("Data")
wsT.Name = "Dog Data" 'rename sheet
wbT.SaveAs wbS.Path & "\dog.xlsx" 'save new workbook
wsT.UsedRange.AutoFilter Field:=3, Criteria1:="=dog"
End Sub
aI have an Excel 2007 workbook with about 150+ worksheets and I want to select the data from the same same cell in all worksheets and copy the data (it is all text) from only those cells that contain data; to a separate worksheet with the data listed in a column.
You can use the following VBA:
Dim WriteCell as Range
Set WriteCell = Sheets("New Sheet").Range("A2")
Dim MySheet as Worksheet
For Each MySheet In ThisWorkbook.Worksheets
If MySheet.Range("B2").Value <> "" Then
WriteCell.Value = MySheet.Range("B2").Value
WriteCell.Offset(0, -1).Value = MySheet.Name
Set WriteCell = WriteCell.Offset(1,0)
End If
Next
That's if it's the same worksheet within that workbook. If you want it to be some other workbook, replace the For Each line with this:
Workbooks.Open File:= "C:\MyBook.xlsx"
For Each MySheet in ActiveWorkbook.Worksheets
This will just iterate through all of the worksheets, testing that value, and generating a worksheet with Worksheet Name and Cell Value as columns.