In this latest project the desire is to have a button & macro that will do the following:
When clicked the macro will copy all the data from the existing workbook & save it to another location. To create the copy of the workbook I will be using the following code below:
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Data.xlsm"
Application.DisplayAlerts = True
This code was sourced from - http://goo.gl/t7qOyB
Once the copy has been archived, the data in the existing workbook must then be removed leaving all the formatting behind. How can removing the data but keeping the formatting be achieved?
Use the .ClearContents() property of Cells Collection
Sub ClearAll()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Cells.ClearContents
Next
End Sub
This code iterates through all sheets in the current workbook and deletes the values from cells keeping the formatting.
Update!
If you wanted to clear only specific range on each sheet then
Sub ClearAll()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Range("A1:B20").ClearContents
Next
End Sub
This will clear only range A1:B20 on each sheet.
Related
In a User form using a Listbox1 I would like to make a list of the Opened Workbooks and in the Listbox2 in the same form the sheets of the selected workbook in the listbox1 But also in the lisbox2 I would like to create with each sheet name a checkbox with five command buttons in the form to import, Export, Erase, Hide or Unhide the selected sheets from Wb1 to Wb2 and vice versa.
So far I receive assistance from you guys to make a do a form with a list of opened workbooks and a list of the respective worksheets here also I'm trying to get to work a code to import the sheets from one workbook to another here,. Do you know a Way to make this happen.
thank You
By the way this is the code use from a sheet to erase the sheets that might be put in the list
Sub DeleteSheets()
Dim wks As Worksheet
Dim MyRange As Range
Dim cell As Range
Set wks = Worksheets("Controls")
With wks
Set MyRange = Range("D5:D34", .Cells(.Rows.Count, "H").End(xlUp))
End With
On Error Resume Next
Application.DisplayAlerts = False
For Each cell In MyRange
Sheets(cell.Value).Delete
Next cell
Application.DisplayAlerts = True
On Error GoTo 0
Sheets("Controls").Range("D5:D34").ClearContents
End Sub
And this ones for hide and unhide the sheets:
Sub Hide_Sheets()
'In use
'Hide the sheets in Controls Sheet
Dim cell As Range
On Error Resume Next
For Each cell In Sheets("Controls").Range("E5:E34")
' Hide sheets
Sheets(cell.Value).Visible = False
Next cell
End Sub
Sub Unhide_Sheets()
'In use
'Unhide the sheets in Controls Sheet
Dim cell As Range
On Error Resume Next
For Each cell In Sheets("Controls").Range("G5:G34")
' Hide sheets
Sheets(cell.Value).Visible = True
Next cell
End Sub
I suggest the following structure of your userform:
Since you do what two lists one with workbooks and one with the worksheets of the currently selected workbook. Then you want to have five command buttons for the actions you want to perfom.
In order to update the workbooks and worksheets you will want to place code in the userform inside the Userform_activate and Listbox1_Change events. So You get the code to list all the workbook names into the listbox1 and put it into Userform_Activate. Evertime the userform is activated the list of workbooks will be updated.
If you now select a entry of listbox1 you want the code to update your sheet names. So you get the code to update the sheet names of a workbook with name "wbname" and put it into listbox1_Change. You then do the following code:
Private Sub ListBox1_Change()
Dim wbname as string
wbname=ListBox1.Value
call GetSheetNamesIntoListBox2(wbname)
End Sub
Where of course GetSheetNamesIntoListBox2 is the sub were you get all the sheetnames into ListBox2.
Lastly you need to setup the Buttons. Each Button has a Click Event which you will want to use. So if the Button is clicked the following code will run:
Private Sub CommandButton1_Click()
Dim wbname as string, wsname as string
wbname=Listbox1.Value
wsname=Listbox2.Value
' You may want to check if wbname and wsname are valid before running the Task
PerformAction(wbname,wsname)
End Sub
Where PerformAction is the routine you use to import, export, clear, hide or unhide the sheet.
I know it is no workedout solution but you will be able to adjust this general solution to your specific case. If you run into problems using my approach just ask in the comments.
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've been able to make an exact copy of a worksheet and add it to the workbook with:
Sub Test()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Detailed List")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub
but I'm trying to have the copied worksheet paste over another worksheet. For example, I'm trying to copy the worksheet "Detailed List" and have it paste and overwrite "Testing Sheet", but all I'm able to do with the code above is make another worksheet. Any help would be great.
You nearly had it, and your own solution works...however, in the efforts of completeness...
Sub Test()
Dim ws1 As Worksheet
Dim ws1Copy As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Detailed List")
ws1.Copy ThisWorkbook.Sheets(Sheets.Count) 'we can't set the copied object directly to a varaiable, but it becomes the active sheet by default
Set ws1Copy = ActiveSheet 'assign the newly copied activesheet to a variable
Application.DisplayAlerts = False 'supress warnings, the delete method gives the user a warning
Sheets("Testing Sheet").Delete 'delete the testing sheet
Application.DisplayAlerts = True 'un-supress the warnings
ws1Copy.Name = "Testing Sheet" 'change the name of the copied sheet to the testing sheet.
End Sub
So I ended up doing this:
Worksheets("Detailed List").Range("A7").CurrentRegion.Copy
Worksheets("Detailed Copy").Range("A7").PasteSpecial
I first just copied the Detailed List before I started running the macro. Then I highlighted all the data points and titles, and overwrite the Copy. I needed to do this because I am making a macro that whenever someone changes a cell in the "Detailed List", I need to display the Old Value that used to be in the cell, so by having essentially two copies of the List, I can first make the comparisons, and then just copy the list over and over, so it automatically updates itself to any changes that have been made.
So prior to asking this I searched and found something that was similar to what I was looking to do here.
Basically I have workbook AlphaMaster. This workbook is a template that I want to use to create new workbooks from weekly.
In this workbook there are sheets named: Monday-Saturday and additional sheets with a corresponding date for Mon, Tues, ect.
I have created a Form that loads on open of the workbook. What I want is when I click form run it will:
Run Code saving template as new workbook
Rename workbook based of input from userform1
Rename the workbooks with proper weekday
Workbook is named for a week end date dates of 6 sheets would renamed after this(example week ending 5th of Jan.) is put into user form as:
WeekEnd: Jan-5-2014
Dates
Mon:Dec.30
Tues:Dec.31
Weds:Jan.1
Thurs:Jan.2
Fri:Jan.3
Sat:Jan.4
Than click command. so far this is what I have:
Private Sub CommandButton1_Click()
Dim thisWb As Workbook, wbTemp As Workbook
Dim ws As Worksheet
On Error GoTo dummkopf
Application.DisplayAlerts = False
Set thisWb = ThisWorkbook
Set wbTemp = Workbooks.Add
On Error Resume Next
For Each ws In wbTemp.Worksheets
ws.Delete
Next
On Error GoTo 0
For Each ws In thisWb.Sheets
ws.Copy After:=wbTemp.Sheets(1)
Next
wbTemp.Sheets(1).Delete
wbTemp.SaveAs "blahblahblah\New.xlsx"
new.xlsx i want to be filled in from form
Vorfahren:
Application.DisplayAlerts = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Vorfahren
End Sub
Complications:
Currently while this does work I cant change the name of the document its named what I name it in the .saveAs area. I'm thinking I need to create an alternate function to handle this. Second, when it finishes my sheets are displayed in the reverse order of the template.
Some guidance/suggestions on where to go from here would be greatly appreciated!
A few issues here:
You cannot delete all Worksheets in a Workbook.
You should copy the sheet to the end to retain order (if the worksheets in source workbook is sorted):
For Each ws In thisWb.Sheets
ws.Copy After:=wbTemp.Sheets(wbTemp.Sheets.Count)
wbTemp.Sheets(wbTemp.Sheets.Count).Name = "NewSheetName" ' <-- Rename the copied sheet here
Next
If your source Worksheets does not have names "Sheet#" then delete the default sheets afterwards.
Application.DisplayAlerts = False
For Each ws In wbTemp.Sheets
If Instr(1, ws.Name, "Sheet", vbTextCompare) > 0 Then ws.Delete
Next
Application.DisplayAlerts = True
For SaveAs, refer to Workbook.SaveAs Method (Excel).
I use this in my application and works good
Set bFso = CreateObject("Scripting.FileSystemObject")
bFso.CopyFile ThisWorkbook.FullName, destinationFile, True
Once it's copied you can then open it in new Excel Object and do what ever you want with it.
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