How would I replicate a sheet using VBA Macro but not use the VBA copy method?
So I want Sheet2 to look exactly like Sheet1 after.
I am new to VBA Macros so please guide me.
Here are couple of ways
WAY 1 Best way to do it
ThisWorkbook.Sheets("Sheet1").Copy _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Way 2
Sub Sample()
Dim wsToCopy As Worksheet, wsNew As Worksheet
On Error GoTo Whoa:
Set wsToCopy = ThisWorkbook.Sheets("Sheet1")
Set wsNew = ThisWorkbook.Sheets.Add
wsNew.Name = "Copy of " & wsToCopy.Name
wsToCopy.Cells.Copy wsNew.Cells
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
NOTE:
In case you are using Excel 2003, then WAY 2 might be the best way depending on the data. Please SEE THIS
Related
I have 3 queries (Power Query) in my Excel file that bring information from other different files in table format and in another worksheet I have a button that executes the ThisWorkbook.RefreshAll function.
Sub ButtonRefreshData()
ThisWorkbook.RefreshAll
End Sub
The problem is: Every time I update my queries, either through the button or Excel's own Refresh/Refresh all tool, my Active Worksheet is changed to the tables that I'm refreshing.
I also tried to set the sheet that I want as active after the refresh with something like ThisWorkbook.Sheets("MySheet").Activate, but no results.
How can I update my queries without changing my active sheet?
I'm currently using Excel 2016.
What I'm trying to do: I want the user to be able to update the data in the worksheet, but I don't want him to have direct access to the tables/data in the worksheets that will be hidden. The user must remain in the "main worksheet", which has the update button.
Activate the Previously Active Sheet
I couldn't reproduce your issue. I created two queries but both of them didn't change the ActiveSheet. Here are two ideas, the second being a bit too extreme i.e. it may hang or crash Excel. Your feedback is appreciated.
EDIT
Possibly get rid of all related to ash and just use the explicit Sheet1.Select after twRefresh.
Option Explicit
Sub Test1()
Application.ScreenUpdating = False
Dim ash As Object: Set ash = ActiveSheet
twRefresh
ash.Select
Application.ScreenUpdating = True
End Sub
Sub twRefresh
ThisWorkbook.RefreshAll
End Sub
Initial Ideas
Option Explicit
Sub Test1()
Application.ScreenUpdating = False
Dim ash As Object: Set ash = ActiveSheet
ThisWorkbook.RefreshAll
DoEvents
ash.Select
Application.ScreenUpdating = True
End Sub
Sub Test2()
On Error GoTo ClearError
Application.Visible = False
Dim ash As Object: Set ash = ActiveSheet
ThisWorkbook.RefreshAll
DoEvents
ash.Select
ProcExit:
Application.Visible = True
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume ProcExit
End Sub
Another user who had a similar problem reported that he was unable to resolve the issue and he attributed the cause to the version of Excel he was using, which turned out to be the same as mine.
In this sense, I assume that the cause is some bug in the version: Excel 2016 - 16.0.4266.1001
If you are having the same problem, please try to use newer versions.
I've encountered a strange thing: I've joined three workbooks: Personal Data Tracker, Global Tracker and the workbook with pivots and charts. The logic is as it follows: the user clicks on a button after the work is finished so the data is copied to the GL Tracker. Once the change event is triggered in the GL Tracker Table, the last workbook opens, the pivot is refreshed upon the open vent and the wb is closed.
Everything seems to be working fine, however when I run the macro live, at the very end I get an error message about
"Application-defined or object-defined error".
Only OK and Help button displayed, it doesn't make the VBE Open so I could debug it.
Would anyone know what it may be happening even if the whole chain works fine?
Thank you.
Code from the Personal Tracker:
Sub test()
Dim path As String
Dim wb As Workbook
path = ThisWorkbook.path & "\Dest.xlsm"
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Total").Range("R1").Value = Date
Range("R1").Font.Color = VBA.ColorConstants.vbWhite
Worksheets("TOTAL").Range("B2:B13").Copy
On Error GoTo Handler
Workbooks.Open (path)
On Error GoTo 0
Set wb = Workbooks("Dest")
Worksheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValues
Exit Sub
Handler:
MsgBox "Someone else is saving their data at the moment." & vbNewLine & _
"Please try in a few seconds"
End Sub
Code from the GL Tracker:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MRange As Range
Dim wbPivot As Workbook
Dim pt As PivotTable
Dim ws As Worksheet
Dim Name As String
Dim answer As VbMsgBoxResult
Set MRange = ThisWorkbook.Sheets(1).Range("Table1")
Name = Application.UserName
Application.ScreenUpdating = False
If Not Intersect(Target, MRange) Is Nothing Then
Application.EnableEvents = True
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Pivot.xlsm")
End If
'refresh
For Each ws In wbPivot.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.Refresh
pt.Update
pt.RefreshTable
Next
Next
'saving
Application.ScreenUpdating = True
If Application.UserName <> "Jakub Tracz" Then
MsgBox "User not authorised. Workbook will be closed."
wbPivot.Close True
ThisWorkbook.Close True
Else
answer = MsgBox(Prompt:="Do you want to save and close the workbook?", _
Buttons:=vbYesNo + vbQuestion)
Select Case answer
Case vbYes
wbPivot.Close True
ThisWorkbook.Close True
Case vbNo
MsgBox "Welcome, " & Application.UserName
End Select
End If
End Sub
I'm going to give you a proof of concept code as an example for you to use. This will not exactly answer your question with code you can just copy/paste, but you will be able to use this to put it together the way you want it to work instead of me making assumptions about many things and restructuring it myself.
This simply demonstrates how to use a workbook object variable in one routine that can reference another workbook, and how to make changes to that 2nd workbook and save/close it.
Sub Tracker_Update()
Dim wbPivot as Workbook
' open the workbook
Set wbPivot = Workbooks.Open("C:\Users\jakub\Desktop\Excel - various\Test.xlsx")
' optionally make it hidden
wbPivot.Visible = False
With wbPivot
' pretend this code updates the pivot table
.Worksheets(1).Range("A1") = "hello world"
' Close and save it
.Close True
End With
' optionally clear the variable
' this is not really needed in VBA, but if you eventually
' start using VB.NET with Excel as a COM object,
' you will want to know how to do this part when you are done
Set wbPivot = Nothing
End Sub
I think you will like this approach in the end much better in the end anyway, as the code isn't scattered around so much in different places. Easier to debug later, and easier for someone else to understand what you are doing if and when you leave the company.
I am using an excel Workbook for programtical generation. Once the workbook is created few of the sheets are having required data and few are blank with default templates only.
I need to delete all sheets having default templates (means no data). I can check specific cell to identify this however need to know how to check for all sheets and then delete sheets one by one.
I am having this piece of code:
Sub TestCellA1()
'Test if the value is cell D22 is blank/empty
If IsEmpty(Range("D22").Value) = True Then
MsgBox "Cell A1 is empty"
End If
End Sub
Try this:
Sub DeleteEmptySheets()
Dim i As Long, ws As Worksheet
' we don't want alerts about confirmation of deleting of worksheet
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
Set ws = Worksheets(i)
' check if cell D22 is empty
If IsEmpty(ws.Range("D22")) Then
Sheets(i).Delete
End If
Next
' turn alerts back on
Application.DisplayAlerts = True
End Sub
An alternative implementation using For-Each:
Sub deleteSheets()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = Workbooks("Name of your Workbook")
'Set wb = ThisWorkbook You can use this if the code is in the workbook you want to work with
Application.DisplayAlerts = False 'skip the warning message, the sheets will be deleted without confirmation by the user.
For Each sht In wb.Worksheets
If IsEmpty(sht.Range("D22")) And wb.Worksheets.Count > 1 then
sht.Delete
End If
Next sht
Application.DisplayAlerts = True
End Sub
This mainly serves as a demonstration pf how you can easily loop through worksheets.
As suggested in the comments below by #Darren Bartrup-Cook , the logic according to which the sheets are deleted can and should be modified to not only suit your purposes but to also include safeguards.
Making sure there's always at least one worksheet in the workbook is one of them. This can be ensured in a multitude of ways. I updated my answer to implement one these.
I have a workbook that the workbook formatting is changed regularly, however once changed (maybe weekly or monthly) then going forward until it is changed again a macro needs to replicate that format. Changing the VBA to account for the new formatting each time is very time consuming. Is it possible to format a workbook and then copy the formatting easily to VBA (after the fact not like a macro record) for future use?
In the past I have since used a hidden sheet within the workbook where the macro runs and I essentially copy/paste that into the sheet I am working with. This works but has the downside of when making changes I first need to copy data over to the "template" sheet to ensure everything is correctly aligned with new data.
Possibly some kind of macro that iterates through all cells of a range and outputs to the immediate window the VBA code needed to re-create the formatting?
Basically any ideas will help :)
There are so many formatting options that simply storing them as separate options will take far more space than just a duplicate template sheet. Just run the first code to update your template, and the second to copy it back:
option Explicit
Const TemplatesheetName = "mytemplate"
Sub CopyFormatting
dim ws as worksheet
dim source as worksheet
set source = activesheet
for each ws in worksheets
if ws.name = templatesheetname then
exit for
end if
next ws
if ws is nothing then
set ws = worksheets.add
ws.name = templatesheetname
end if
ws.usedrange.clearformats
source.usedrange.copy
ws.range("a1").pastespecial xlpasteformats
ws.visible = xlveryhidden
end sub
Sub BringBackFormats
dim ws as worksheet
for each ws in worksheets
if ws.name = templatesheetname then
exit for
end if
next ws
if ws is nothing then
msgbox "No template found",vbokonly,"Unabl;e to run"
else
ws.cells.copy
activesheet.range("a1").pastespecial xlpasteformats
end if
exit sub
(written on my phone, can't check the code, there may be typos)
I have a CommandButton which opens a UserForm and create a copied Sheet with the name of the ComboBox Value.
This is My Code:
Private Sub CommandButton1_Click()
[UserForm1].Show ' Open UserForm
End Sub
Private Sub CommandButton2_Click()
Dim ws As Worksheet
ActiveWorkbook.Sheets("Sheet1").Visible = True ' Unhide Sheet
Sheets("Sheet1").Copy _
Before:=ActiveWorkbook.Sheets("Sheet1") ' Copy Sheet
Set ws = ActiveSheet
ws.Name = ComboBox1.Value ' Name Sheet
[UserForm1].Hide ' Close UserForm
ActiveWorkbook.Sheets("Sheet1").Visible = False ' Hide Sheet again
End sub
Now my problem is, if there are two machines with name "Machine Type 1" Excel gets an Error. So what do i have to change in my code, that the second sheet would named e.g. "Machine Type 1 (2)?
Thanks for your help.
you could try this
Private Sub CommandButton1_Click()
If IsSheetThere(ComboBox1.Value) Then 'if some sheet with chosen name already there
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
With ActiveSheet 'reference just copied sheet
.UsedRange.Clear 'clear its content
Sheets("Sheet1").UsedRange.Copy ActiveSheet.Range("A1") ' copy Sheet1 content and paste into it
End With
Else 'otherwise
Sheets("Sheet1").Copy Before:=Sheets(Sheets.Count) ' make a copy of "Sheet1" sheet
ActiveSheet.Name = ComboBox1.Value 'and rename it as per chosen name
End If
Me.Hide
End Sub
Function IsSheetThere(shtName As String) As Boolean
On Error Resume Next
IsSheetThere = Not Sheets(shtName) Is Nothing
End Function
the code line:
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
is the one that leaves Excel the burden of somehow "counting" the number of already existing sheets with the chosen name, and name the new one appropriately
You can use the following sub which calls the below function, just apply the same logic using .Copy
Sub create_new_sheet_with_name(name As String, wb As Workbook, aftersheet As Variant)
Dim i As Integer
i = 2
If sheet_name_exists(name, wb) Then
Do While sheet_name_exists(name & " (" & i & ")", wb)
i = i + 1
Loop
wb.Sheets.Add(after:=aftersheet).name = name & " (" & i & ")"
Else
wb.Sheets.Add(after:=aftersheet).name = name
End If
End Sub
Function sheet_name_exists(name As String, wb As Workbook) As Boolean
For Each sheet In wb.Worksheets
If sheet.name = name Then
sheet_name_exists = True
Exit Function
End If
Next sheet
sheet_name_exists = False
End Function
here's an example of how to use the sub:
Sub test()
create_new_sheet_with_name "hi", ThisWorkbook, ThisWorkbook.Sheets(1)
'this adds a new sheet named "hi" to thisworkbook after thisworkbook.sheets(1)
End Sub
Technically this isn't an answer to this question... but it's better because it will help you solve this and many other coding tasks on your own.
There is a simple way to create VBA code for most basic tasks.
If there's something Excel can do that you want to be able to do programmatically, just Record a Macro of yourself performing the action(s), and then look at the code that Excel generated.
I have a terrible memory, I can't remember commands I used yesterday. So it's not only quicker and less frustrating for others for me to figure it out myself, but the more often I do that, the quicker I'll learn (without asking others to do the thinking for me on a basic question).
I fact, I'm guess that the majority of veteran VBA coders learned at least partly by analyzing recorded macros. I know I did.