I have a workbook that I need to create 150 copies of. I have the list of what I want to save each new workbook as in cells A1 to A150 in another workbook.
I've looked around but I can't find any code that does what I need. If it makes it easier, I could put the list into the template workbook, but would need to delete that sheet from each new workbook before saving and closing it.
This code should help you:
Sub Sample()
Dim wsToCopy As Worksheet, wsNew As Worksheet
With Sheets("Sheet1")
LastRow = Sheets("Sheet1").Cells(.Rows.Count, 1).End(xlUp).Row
For a = 1 To LastRow
Set wsToCopy = ThisWorkbook.Sheets("TemplateSheet")
Set wsNew = ThisWorkbook.Sheets.Add
wsNew.Name = Sheets("Sheet1").Cells(a, 1).Value
wsToCopy.Cells.Copy wsNew.Cells
Next
End With
End Sub
Explaining:
At a sheet named "Sheet1", you need to have a list of the to-create sheets names, starting at the first row, always in the first column.
The macro will create a new sheet, rename-it and copy everything from the sheet "TemplateSheet". And then, will pass to the next Sheet1's row.
So basically, just name your template sheet as "TemplateSheet" and add the 150 names at the first row of "Sheet1".
You can delete the template and the Sheet1 later.
Related
I am trying to copy all the used cells in an excel worksheet from a closed workbook into an already created worksheet in my current workbook using VBA.
Have seen lots of examples on copy the sheet as a new sheet but not just the used contents into an existing sheet.
Thanks!
Mike
Open the source workbook, using:
set wb = Workbooks.Open FileName:="fullPathAndFileName.xlsx", UpdateLinks:=0, ReadOnly:=True, AddToMru:=False
Using a reference to the sheet you want to copy, eg., wb.Sheets(1) (refers to the first sheet in the workbook), and a reference to your destination sheet, eg. destWorkSheet run a loop like this:
For Each cel in wb.Sheets(1).UsedRange.Cells
destWorkSheet.Cells(cel.Row, cel.Column) = cel
Next
This will copy the values cell by cell to the same location in the destination worksheet as they are in the source worksheet. You probably want to turn calculation off first. There are certainly other ways to do it as well.
You will still need to open the source workbook, but another approach is to do a direct write of Values. You can do this as long as the destination and source ranges are the same size and shape. This subroutine will do it for you:
Private Sub CopyValuesSourceToDest(src As Range, dest As Range)
'dest should be one cell, src can be a range of cells
If dest.Cells.Count <> 1 Then MsgBox "Only pass one cell as the destination.": Exit Sub
Dim rws As Long, cols As Long, trueDest As Range
rws = src.Rows.Count
cols = src.Columns.Count
Set trueDest = dest.Parent.Range(dest.Cells(1, 1), dest.Cells(1, 1).Offset(rws - 1, cols - 1))
trueDest.Value = src.Value
End Sub
You would then call the sub like this:
CopyValuesSourceToDest sourceSheet.UsedRange, destSheet.Range("B7") 'B7, or whatever
im trying to copy the active sheet and 2 specified sheets to a new workbook and then have the macro to continue to run on the new workbook to change a few things before i save it
i want to copy the sheets by the sheets codenames
1st Sheet 3 to copy this will be the "active sheet"
2nd Sheets codename is "DropDown_Sheet_1_VB"
3rd Sheets codename is "Control_Sheet_VB"
Example Code.
Sub Create_Work_Order()
Workbooks.Add
ActiveSheet.Copy 'copy to new workbook
DropDown_Sheet_1_VB.Copy 'also copy to new workbook
Control_Sheet_VB.Copy 'also copy to new workbook
Dim NewWB As Workbook
NewWB.ActiveSheet.Range("A1").Copy 'do stuff on new workbook
NewWB.Save
End Sub
I don't know what is the stuff at the end other than copying A1 range but I put it there too.
You simply need to assign the workbook object (wrk in my sample, NewWB in your sample - variable name doesn't matter) at the beginning and tell the Copy method where to copy. You will see that I specified first parameter - which is :Before - as wrk.Worksheets(1), so copied sheets are copied just before the first worksheet in the new workbook.
Sub Create_Work_Order()
Dim currentWrk As Workbook
Dim wrk As Workbook
Set currentWrk = ActiveWorkbook
Set wrk = Workbooks.Add
currentWrk.ActiveSheet.Copy wrk.Worksheets(1)
DropDown_Sheet_1_VB.Copy wrk.Worksheets(1)
Control_Sheet_VB.Copy wrk.Worksheets(1)
'wrk.ActiveSheet.Range("A1").Copy 'do stuff on new workbook
wrk.Save
' EDIT: I added following to change the functions to refer to the new file
wrk.ChangeLink currentWrk.FullName, wrk.FullName, xlExcelLinks
wrk.Save
End Sub
I have a plethora of Excel workbooks containing 25+ worksheets each containing 20 columns of data from range 1:500 (or 1:1000 in some cases). Frequently I am tasked with updating the "template" onto which new data is entered for new calculations. I want to be able to easily paste extant data from old worksheets into sheets with new formatting while retaining any new formatting/formulas in the new templates.
I am using VBA to open the sheet I want to copy and paste it onto the new template sheet. So far my code will copy everything from the first sheet (S1) of the to-be-copied workbook and paste it onto the first sheet (S1) of the target workbook.
I want to extend this process to go through all active sheets (do whatever it is doing now for each sheet in the workbooks). I previously was able to do this with different code but it removed the formulas in rows 503 and 506 that I need when it pasted in. Can I do a pastespecial and skip empty cells? I am new to this.
Here is my current code:
Sub CopyWS1()
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks("Ch00 Avoid.xlsx")
Set y = Workbooks("Ch00 Avoid1.xlsx")
Dim LastRow As Long
Dim NextRow As Long
x.Worksheets("S1").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row
Range("A2:T" & LastRow).Copy y.Worksheets("s1").Range("A1:A500")
Application.CutCopyMode = False
Range("A1").Select
End Sub
I believe that I need to use something like the following code in order to extend this across the worksheets, but I'm not sure how to iterate through the sheets since I'm specifically referencing two sheets in my above code.
Sub WorksheetLoop2()
' Declare Current as a worksheet object variable.
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
' Insert your code here.
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
I imagine that I might be able to solve this as a for loop across an index of worksheets (make a new variable and run a for loop until my index is 25 or something) as an alternative, but again, I'm not sure how to point my copy/paste from a particular sheet to another sheet. I am very new to this with semi-limited experience with Python/Java only. These VBA skills would greatly benefit me on the day to day.
The two files in question:
Ch00 Avoid
Ch00 Avoid1
This should do it. You should be able to drop this in a blank workbook just to see how it works (put some values in column A on a couple of sheets). Obviously you will replace your wbCopy and wbPaste variables, and remove the wbPaste.worksheets.add from the code (my excel was only adding 1 sheet in the new workbook). LastRow is determined per your code, looking up from column A to find the last cell. wsNameCode is used to determine the first part of your worksheets you are looking for, so you will change it to "s".
This will loop through all sheets in your copy workbook. For each of those sheets, it's going to loop 1 through 20 to see if the name equals "s" + loop number. Your wbPaste has the same sheet names, so when it finds s# on wbCopy, it is going to paste into wbPaste with the same sheet name: s1 into s1, s20 into s20, etc. I didn't put in any error handling, so if you have an s21 on your copy workbook, s21 needs to be on your paste workbook, and NumberToCopy changed to 21 (or just set it to a higher number if you plan on adding more).
You could have it just loop through the first 20 sheets, but if someone moves one it will throw it all off. This way sheet placement in the workbook is irrelevant as long as it exists in the paste workbook.
You can also turn screenupdating off if you don't want to have a seizure.
Option Explicit
Sub CopyAll()
'Define variables
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wbPaste As Workbook
Dim LastRow As Long
Dim i As Integer
Dim wsNameCode As String
Dim NumberToCopy As Integer
'Set variables
i = 1
NumberToCopy = 20
wsNameCode = "Sheet"
'Set these to your workbooks
Set wbCopy = ThisWorkbook
Set wbPaste = Workbooks.Add
'These are just an example, delete when you run in your workbooks
wbPaste.Worksheets.Add
wbPaste.Worksheets.Add
'Loop through all worksheets in copy workbook
For Each wsCopy In wbCopy.Worksheets
'Reset the last row to the worksheet, reset the sheet number search to 1
LastRow = wsCopy.Cells(65536, 1).End(xlUp).Row
i = 1
'Test worksheet name to match template code (s + number)
Do Until i > NumberToCopy
If wsCopy.Name = (wsNameCode & i) Then
wsCopy.Range("A2:T" & LastRow).Copy
wbPaste.Sheets(wsNameCode & i).Paste
End If
i = i + 1
Loop
Next wsCopy
End Sub
Thank you for all of your help, everyone. I went back yesterday afternoon from scratch and ended up with the following code which, at least to my eyes, has solved what I was trying to do. The next step will be to try to make this less tedious as I have a gajillion workbooks to update. If I can find a less obnoxious way to open/update/save/close new workbooks, I will be very happy. As it stands now, however, I have to open both the example workbook and the target workbook, save both, and close...but it works.
'This VBA macro copies a range of cells from specified worksheets within one workbook to a range of cells
'on another workbook; the names of the sheets in both workbooks should be identical although can be edited to fit
Sub CopyToNewTemplate()
Dim x As Workbook
Dim y As Workbook
Dim ws As Worksheet
Dim tbc As Range
Dim targ As Range
Dim InxW As Long
Dim WshtNames As Variant
Dim WshtNameCrnt As Variant
'Specify the Workbook to copy from (x) and the workbook to copy to (y)
Set x = Workbooks("Ch00 Avoid.xlsx")
Set y = Workbooks("Ch00 Avoid1.xlsx")
'Can change the worksheet names according to what is in your workbook; both worksheets must be identical
WshtNames = Array("S1", "S2", "S3", "S4", "S5", "S6", "S7", "s8", "s9", "S10", "S11", "S12", "S13", "S14", "S15", _
"S16", "S17", "S18", "S19", "S20", "Ext1", "Ext2", "Ext3", "EFS BigAverage")
'will iterate through each worksheet in the array, copying the tbc range and pasting to the targ range
For Each WshtNameCrnt In WshtNames
With Worksheets(WshtNameCrnt)
'tbc is tobecopied, specify the range of cells to copy; targ is the target workbook range
Set tbc = x.Worksheets(WshtNameCrnt).Range("A1:T500")
Set targ = y.Worksheets(WshtNameCrnt).Range("A1:T500")
Dim LastRow As Long
Dim NextRow As Long
tbc.Copy targ
Application.CutCopyMode = False
End With
Next WshtNameCrnt
End Sub
I have an existing workbook that will be used by multiple users (who will name the workbook uniquely - I can set one Workbook Codename if needed though, though don't know how to do this?).
I need to create a macro that opens a new workbook (which presumably I won't know the name of? as it could be 'Book1', 'Book2', 'Book3' etc?), then returns to the original workbook where the macro is stored, and copies several (can do one at a time if needed) sheets (that I DO know the names of these sheets) and pastes them as new sheets into the new workbook that I created at the start. The macro does not need to Save the file (in fact it's preferable that it doesn't as I want the user to save the new workbook wherever is most convenient for the user).
I have attempted to show what the macro would do, showing the obvious problem that I do not know the names of the workbooks I am creating/copying from/pasting into.
Any help, much appreciated!
Sub CopySheetintoNewWorkbook()
'Macro opens new / blank workbook (name unknown?)'
Workbooks.Add
'Macro goes back to original workbook where macro is saved (of which the name is unknown to the macro - i.e., users can and will change it)'
Windows("UnknownWorkbookName-1").Activate
'Macro goes to a sheet which can be named and will be known, so this is no problem'
Sheets("KnownSheet").Select
'Macro creates a copy of the sheet and pastes it as a new sheet within the new, unknown named workbook'
Application.CutCopyMode = False
Sheets("KnownSheet").Copy Before:=Workbooks("UnknownWorkbookName-2").Sheets(1)
End Sub
We want to copy Sheet1 and Sheet2.
This relies on a tiny trick:
Sub qwerty()
Dim wb1 As Workbook, wbNEW As Workbook
Set wb1 = ActiveWorkbook
Sheets("Sheet1").Copy
Set wbNEW = ActiveWorkbook
wb1.Sheets("Sheet2").Copy after:=wbNEW.Sheets(1)
End Sub
When the first .Copy is performed, a new workbook is created and it becomes the ActiveWorkbook ........the rest is easy.
EDIT#1:
If we have a group of sheets to be copied, then we can create an array of sheet names and loop through the array, copying one sheet at a time:
Sub qwerty()
Dim wb1 As Workbook, wbNEW As Workbook
Dim ary() As String, s As String, i As Long
s = "Larry,Moe,Curly"
ary = Split(s, ",")
Set wb1 = ActiveWorkbook
i = 1
For Each a In ary
If i = 1 Then
Sheets(a).Copy
Set wbNEW = ActiveWorkbook
Else
wb1.Sheets(a).Copy after:=wbNEW.Sheets(1)
End If
i = 2
Next a
wbNEW.Activate
End Sub
I have found similar questions that deal with copying an entire worksheet in one workbook and pasting it to another workbook, but I am interested in simply copying an entire worksheet and pasting it to a new worksheet -- in the same workbook.
I'm in the process of converting a 2003 .xls file to 2010 .xlsm and the old method used for copying and pasting between worksheets doesn't paste with the correct row heights. My initial workaround was to loop through each row and grab the row heights from the worksheet I am copying from, then loop through and insert those values for the row heights in the worksheet I am pasting to, but the problem with this approach is that the sheet contains buttons which generate new rows which changes the row numbering and the format of the sheet is such that all rows cannot just be one width.
What I would really like to be able to do is just simply copy the entire worksheet and paste it. Here is the code from the 2003 version:
ThisWorkbook.Worksheets("Master").Cells.Copy
newWorksheet.Paste
I'm surprised that converting to .xlsm is causing this to break now. Any suggestions or ideas would be great.
It is simpler just to run an exact copy like below to put the copy in as the last sheet
Sub Test()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Master")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub
ThisWorkbook.Worksheets("Master").Sheet1.Cells.Copy _
Destination:=newWorksheet.Cells
The above will copy the cells. If you really want to duplicate the entire sheet, then I'd go with #brettdj's answer.
' Assume that the code name the worksheet is Sheet1
' Copy the sheet using code name and put in the end.
' Note: Using the code name lets the user rename the worksheet without breaking the VBA code
Sheet1.Copy After:=Sheets(Sheets.Count)
' Rename the copied sheet keeping the same name and appending a string " copied"
ActiveSheet.Name = Sheet1.Name & " copied"
I really liked #brettdj's code, but then I found that when I added additional code to edit the copy, it overwrote my original sheet instead. I've tweaked his answer so that further code pointed at ws1 will affect the new sheet rather than the original.
Sub Test()
Dim ws1 as Worksheet
ThisWorkbook.Worksheets("Master").Copy
Set ws1 = ThisWorkbook.Worksheets("Master (2)")
End Sub
'Make the excel file that runs the software the active workbook
ThisWorkbook.Activate
'The first sheet used as a temporary place to hold the data
ThisWorkbook.Worksheets(1).Cells.Copy
'Create a new Excel workbook
Dim NewCaseFile As Workbook
Dim strFileName As String
Set NewCaseFile = Workbooks.Add
With NewCaseFile
Sheets(1).Select
Cells(1, 1).Select
End With
ActiveSheet.Paste
If anyone has, like I do, an Estimating workbook with a default number of visible pricing sheets, a Summary and a larger number of hidden and 'protected' worksheets full of sensitive data but may need to create additional visible worksheets to arrive at a proper price, I have variant of the above responses that creates the said visible worksheets based on a protected hidden "Master". I have used the code provided by #/jean-fran%c3%a7ois-corbett and #thanos-a in combination with simple VBA as shown below.
Sub sbInsertWorksheetAfter()
'This adds a new visible worksheet after the last visible worksheet
ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
'This copies the content of the HIDDEN "Master" worksheet to the new VISIBLE ActiveSheet just created
ThisWorkbook.Sheets("Master").Cells.Copy _
Destination:=ActiveSheet.Cells
'This gives the the new ActiveSheet a default name
With ActiveSheet
.Name = Sheet12.Name & " copied"
End With
'This changes the name of the ActiveSheet to the user's preference
Dim sheetname As String
With ActiveSheet
sheetname = InputBox("Enter name of this Worksheet")
.Name = sheetname
End With
End Sub