I have below VBA code:
Sub abc()
Dim wb As Workbook
Set wb = Workbooks("Book1.xlsx")
wb.Sheets("sheet1").Activate
On Error Resume Next
wb.Sheets("Sheet2").Delete
wb.Sheets("Sheet3").Delete
End Sub
I have 1 blank Excel file (Book1.xlsx) with 2 sheets (sheet1 and sheet2).
In Excel 2013 it works.
The same code in Excel 365 is throwing error message
Run time error 9: subscript out of range
Option Explicit
Sub abc()
Dim wb As Workbook
Set wb = Workbooks("Frou Frou.xlsx") '<- Check if the workbook has the correct name.
With wb
Application.DisplayAlerts = False '<- Remove alerts asking for confirmation of deleting the sheet
.Sheets("Sheet2").Delete '<- Check if the both sheets appear in the workbook.
.Sheets("Sheet3").Delete
Application.DisplayAlerts = True '<- Remove alerts
End With
End Sub
Sub deleteSelectedSheets()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = Workbooks("Your.xlsx")
For Each sht In wb.Worksheets
Select Case sht.name
Case Is = "Sheet1" ' You can add as many case as you want
sht.Delete
Case Is = "Sheet2"
sht.Delete
Case Else
' Do nothing
End Select
Next sht
End Sub
Related
How do I call and re-use the workbook that gets created after executing
ThisWorkbook.Sheets("copythis").Copy
I can't use the activeWorkbook since the user will go back to the previous workbook that has the vba.
Dim wbNew As Workbook
ThisWorkbook.Sheets("copythis").Copy
Set wbNew = ActiveWorkbook
MsgBox wbNew.Name
Even if the user goes back and selects something else, you can work with the new workbook using the wbNew object.
The newly created workbook will always be at the end of workbook array. So you can use this also
Dim wbNew
set wbNew = Application.Workbooks(Application.Workbooks.Count)
Worksheet.Copy Method
When using your line of code, the newly created workbook becomes the active one.
The Code
Option Explicit
Sub testWithVariable()
ThisWorkbook.Sheets("copythis").Copy
Dim wb As Workbook
Set wb = ActiveWorkbook
Debug.Print wb.Name
wb.Saved = True
End Sub
Sub testWithoutVariable()
ThisWorkbook.Sheets("copythis").Copy
With ActiveWorkbook
Debug.Print .Name
.Saved = True
End With
End Sub
Sub testWorksheetWithoutVariable()
ThisWorkbook.Sheets("copythis").Copy
With ActiveSheet
Debug.Print .Parent.Name ' workbook
Debug.Print .Name ' worksheet
.Parent.Saved = True
End With
End Sub
I have tried to make this code but still having an issue.
Question is simple -
If sheet2 exists then
ThisWorkbook.Sheets(Sheet1).Range(a1).Select
If does not exist then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1")) ws.Name = "Sheet2"
But after adding sheet2 it still gives error.
Below is the code:
Sub new6()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If ws.Name <> "Sheet2" Then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
Else
ThisWorkbook.Sheets(Sheet1).Range(a1).Select
End If
Next
End Sub
I think you need to change your approach and remove that loop entirely by implementing a great solution from #Tim Williams. The issue with your code is you are adding a new sheet before verifying if the sheet exists in the book.
Add the WorksheetExists function which will scan the entire workbook for a sheet without a loop and return WorksheetExists = TRUE or FALSE. From there you can simplify your macro by removing the loop and acting on the result of the function.
You can also avoid Select here with Application.Goto
Sub new6()
Dim ws As Worksheet
If WorksheetExists("Sheet2", ActiveWorkbook) Then
Application.Goto (Sheets("Sheet1").Range("A1"))
Else
Set ws = Worksheets.Add(After:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
End If
End Sub
Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtName)
On Error GoTo 0
WorksheetExists = Not sht Is Nothing
End Function
Before selecting the A1 range with ThisWorkbook.Sheets(Sheet1).Range(a1).Select, the correct sheet should be selected on the line before.
The second error is that Sheets collection expects a string. Thus:
ThisWorkbook.Sheets("Sheet1").Select
ThisWorkbook.Sheets("Sheet1").Range("a1").Select
For the code above, put a boolean variable, which tracks whether Sheet2 was found. If it was not found, then create a new Worksheet:
Sub new6()
Dim wb As Workbook
Dim ws As Worksheet
dim isFound As Boolean
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If ws.Name <> "Sheet2" Then
'Do Nothing
Else
isFound = True
ThisWorkbook.Sheets("Sheet1").Select
ThisWorkbook.Sheets("Sheet1").Range("a1").Select
End If
Next
If Not isFound Then
Set ws = Worksheets.Add(after:=Worksheets("Sheet1"))
ws.Name = "Sheet2"
End If
End Sub
The code above will throw an error, if "Sheet1" does not exist. But you may try to make sure that it exists with a few additional lines.
In general - try to avoid Select - How to avoid using Select in Excel VBA.
And whenever having queries about Selecting cells in VBA, use the Macro Recorder, for the first couple of months its help will be useful.
I modified code from Copy worksheet into different workbook replacing current data.
If I deselect range or I have selected different cell than A1, code falls into 1004 error.
Sub TG_update()
Dim wb1 As Workbook, wb2 As Workbook, ws1Format As Worksheet, ws2Format As Worksheet, ws3Format As Worksheet, ws4Format As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("[add your path.xlsx]")
Set ws1Format = wb1.Sheets("SheetA1")
Set ws2Format = wb2.Sheets("SheetB1")
Set ws3Format = wb1.Sheets("SheetA2")
Set ws4Format = wb2.Sheets("SheetB2")
'' Copy the cells of the "Format" worksheet.
ws2Format.Cells.Copy
'' Paste cells to the sheet "Format".
wb1.Sheets("SheetA1").Paste
ws4Format.Cells.Copy
wb1.Sheets("SheetB1").Paste
wb2.Close False 'remove false if you want to be asked if the workbook shall be saved.
wb1.Sheets("Store").Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Date successfully updated"
End Sub
Please try this code. Instead of copying and pasting millions of blank cells this code copies the worksheet from the source and pastes it to the workbook with the code. If the action is successful the old sheet is deleted. The final report alerts about errors if sheets weren't found.
Sub TG_update()
' 016
Dim Wb As Workbook ' ThisWorkbook
Dim WbS As Workbook ' Source
Dim Ffn As String ' Full FileName
Dim Ws As Worksheet
Dim TabName() As String
Dim i As Integer ' TabName index
Dim n As Integer ' tab counter
Set Wb = ThisWorkbook
' specify the workbook to be copied from: Full path and name
Ffn = "F:\AWK PC\Drive E (Archive)\PVT Archive\Class 1\1-2018 (Jan 2020)\TXL 180719 Z Distance.xlsm"
' enumerate the sheet names in CSV format (sheets must exist in Wb)
TabName = Split("SheetA1,SheetB1", ",")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set WbS = Workbooks.Open(Ffn)
For i = 0 To UBound(TabName)
On Error Resume Next ' suppress error if worksheet isn't found
WbS.Worksheets(TabName(i)).Copy After:=Wb.Worksheets(Wb.Worksheets.Count)
If Err.Number = 0 Then
n = n + 1
End If
Next i
WbS.Close SaveChanges:=False
On Error GoTo 0
For i = 0 To UBound(TabName)
For Each Ws In Wb.Worksheets
If InStr(Ws.Name, TabName(i) & " (") = 1 Then
Wb.Worksheets(TabName(i)).Delete
Ws.Name = TabName(i)
End If
Next Ws
Next i
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
MsgBox n & " of " & i & " worksheets were successfully updated.", _
vbInformation, "Action report"
End Sub
Creative names like Wb1, Wb2, Ws1, Ws2, SheetA1, SheetA2 represent the punishment imaginative programmers inflict on those who come after them to correct their hastily concocted code. Give your VBA project a better reputation by bestowing names on your two worksheets that permit their identification.
My workbook has both chart sheets and normal sheets, therefore I am using Sheets instead of Worksheets. However, I don't know what the type of sht should be in the following set of codes. I am sure it cannot be Worksheet.
' Hide all sheets/charts except Sheet1
Sub Hide_Sheets()
Dim sht As ???
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> Sheet3.Name Then
sht.Visible = False
End If
Next sht
End Sub
"Charts and Worksheets are two different collections." --> https://stackoverflow.com/a/6804704/138938
If you have both chart sheets and regular worksheets, you can either loop through a collection of objects like this:
Sub Hide_Objects()
Dim wb As Workbook
Dim obj As Object
Set wb = ActiveWorkbook
For Each obj In wb.Sheets
If obj.Name <> "Sheet1" Then
obj.Visible = False
End If
Next obj
End Sub
Or you can loop through both collections like this:
Sub Hide_Sheets_And_Charts()
Dim wb As Workbook
Dim sht As Worksheet
Dim cht As Chart
Set wb = ActiveWorkbook
For Each sht In wb.Worksheets
If sht.Name <> "Sheet1" Then
sht.Visible = False
End If
Next sht
For Each cht In wb.Charts
If cht.Name <> "Sheet1" Then
cht.Visible = False
End If
Next cht
End Sub
Use Variant then step through the code and you'll be able to see what it is.
Variant will work without doing anything else.
I recommend using real names for variables to make it easier for you to read your code at some stage in the future.
Sub Hide_Sheets()
Dim sheet_ As Variant
For Each sheet_ In ActiveWorkbook.Sheets
If sheet_.Name <> Sheet3.Name Then
sheet_.Visible = False
End If
Next sheet_
End Sub
I am wanting to have a button open a userform with a list of all open Workbooks. The user selects the workbook they want and the code copies data from a fixed range in the current workbook and pastes it into a fixed range in the user selected workbook.
While searching around I found this code, that works similarly but copies from the selected workbook and pastes into the current one.
Option Explicit
Const PSWD = "atari"
Private Sub CancelButton_Click()
Unload Me
End Sub
Private Sub CopyPasteButton_Click()
ActiveSheet.Unprotect Password:=PSWD
'This code will be executed when the "Copy" button is clicked on the userform.
Dim wsData As Worksheet
Dim rCopy As Range
Dim CopyRw As Long
Set wsData = ThisWorkbook.Sheets("SALES Details")
With Application
.DisplayAlerts = False
.ScreenUpdating = True
With wsData
.Unprotect PSWD
CopyRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
On Error GoTo exit_err
With Workbooks(Me.ListBox1.Value).Sheets("Master Sheet")
Set rCopy = .Cells(10, 1).CurrentRegion
Set rCopy = rCopy.Offset(1, 0).Resize(rCopy.Rows.Count - 1, 40)
rCopy.Copy ThisWorkbook.Sheets("SALES Details").Cells(CopyRw, 1)
End With
Unload Me
exit_err:
wsData.Protect Password:=PSWD
.DisplayAlerts = True
.ScreenUpdating = True
.CutCopyMode = False
End With
End Sub
Private Sub UserForm_Activate()
'Populate list box with names of open workbooks, excluding main workbook.
Dim wb As Workbook
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then ListBox1.AddItem wb.Name
Next wb
End Sub
This code works great, for what it does. I have been trying to edit it without luck. How can I edit this to reverse the direction and have it copy from a fixed range in the current sheet (A50:J57) to a fixed range on the user selected sheet (A4:J11)?
I think this should work. Of course you have to adapt the sheet names in code.
Private Sub CopyPasteButton_Click()
Dim mySheet As Worksheet, otherSheet As Worksheet
On Error GoTo exit_err
Application.DisplayAlerts = False
Set mySheet = ThisWorkbook.Sheets("SheetXYZ")
Set otherSheet = Workbooks(Me.ListBox1.Value).Sheets("SheetABC")
mySheet.Range("A50:J57").Copy Destination:=otherSheet.Range("A4:J11")
exit_err:
Application.DisplayAlerts = True
End Sub
UPDATE
For copying the values and not the formulas of the range use this code instead of the Copy function:
mySheet.Range("A50:J57").Copy
otherSheet.Range("A4:J11").PasteSpecial xlPasteValuesAndNumberFormats
For further options of the PasteSpecial function see the documentation.