.ShowAllData on remaining sheet after all others deleted - excel

I'm trying to delete any sheet with a title that is not "PR11_P3".
In the remaining sheet there is a table "PR11_P3_Tabell" which is by now always filtered or rather sorted somehow and this is what I'm trying to restore with .ShowAllData.
Sub DeleteSheetRestoreSort()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "PR11_P3" Then
ws.Delete
Then
ActiveSheet.ShowAllData
End If
Next ws
End Sub

There is no guarantee that ActiveSheet is the sheet you want to clear. Use ws instead.
Sub DeleteSheetRestoreSort()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "PR11_P3" Then
ws.Delete
Else
If ws.filtermode then
ws.ShowAllData
End If
End If
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Related

Method 'Visible' of object '_Worksheet' failed

Not sure why this is failing but for whatever reason, when the ActiveSheet is Console it fails. Going the other way, it works properly. Code is below.
Sub Switch_Books()
Dim ws As Worksheet
protect_book True
If ActiveSheet.Name = "Console" Then
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "CDA Console" Then
ws.Visible = xlSheetVisible
Else
ws.Visible = xlSheetHidden
End If
Next ws
Else
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Console" Then
ws.Visible = xlSheetVisible
Else
ws.Visible = xlSheetHidden
End If
Next ws
End If
protect_book False
End Sub
Try this:
Sub Switch_Books()
Dim ws As Worksheet, wsName
protect_book True 'This is a confusing call...
' you should switch the way the boolean works
wsName = IIf(ActiveSheet.Name = "Console", "CDA Console", "Console")
ThisWorkbook.Sheets(wsName).Visible = xlSheetVisible 'must be at least one sheet visible
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> wsName Then ws.Visible = xlSheetHidden
Next ws
protect_book False
End Sub

Excel VBA Copy sheet to new workbook with rename sheet based cell value

I am trying to copy one sheet "RESULTADOS" to new workbook with sheet name based cell value range "U3". My code copies the sheet fine but it is giving error about name and the new file not open fine so i dont know where its mistake. I hope some help.
My code:
Sub CopySheetToNewWorkbook()
Dim wFrom As Workbook
Dim wTo As Workbook
Set wFrom = ActiveWorkbook
Set wTo = Workbooks("FileResult.xlsx")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
With wFrom
.Sheets("RESULTADOS").Range("A1:Y100").Copy
End With
With wTo
With .Sheets("HOJA1")
.Range("A1").PasteSpecial Paste:=xlPasteAll
.name = wFrom.Sheets("RESULTADOS").Range("U3").Value
End With
End With
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Thank you in advance.
The object graph on sheet "RESULTADOS" not copy in new workbook. What parameter is to copy the bar graph objects?
UPDATE code:
Sub CopySheetToNewWorkbook()
Dim wbFrom As Workbook
Dim wbTo As Workbook
Set wbFrom = ThisWorkbook
Set wbTo = "D:\FileResult.xlsx"
Application.ScreenUpdating = False
With wbTo
With .Sheets(.Sheets.Count)
wbFrom.Sheets("RESULTADOS").Range("A1:Y100").Copy
.Range("A1").PasteSpecial
.Range("A1").PasteSpecial xlPasteColumnWidths
.Name = wbFrom.Sheets("RESULTADOS").Range("U3").Value
End With
.Worksheets.Add After:=.Sheets(.Sheets.Count)
.Save
End With
Application.ScreenUpdating = True
End Sub
Copy From One Workbook to Another
PasteType
Option Explicit
Sub CopySheetToNewWorkbook()
Dim wbFrom As Workbook
Dim wbTo As Workbook
Set wbFrom = ThisWorkbook
Set wbTo = Workbooks.Open(ThisWorkbook.Path & "\FileResult.xlsx")
Application.ScreenUpdating = False
With wbTo
With .Sheets("HOJA1")
wbFrom.Sheets("RESULTADOS").Range("A1:Y100").Copy
.Range("A1").PasteSpecial
.Range("A1").PasteSpecial xlPasteColumnWidths
.Name = wbFrom.Sheets("RESULTADOS").Range("U3").Value
End With
.Worksheets.Add After:=.Sheets(.Sheets.Count)
ActiveSheet.Name = "HOJA1"
'.Save
'.Close
End With
Application.ScreenUpdating = True
End Sub

Delete all visible sheets but a specific sheet

I have an issue with below code.
I want to delete all visible sheets but a certain sheet, when a user closes the workbook.
This is the code:
Private Sub workbook_BeforeClose(cancel As Boolean)
Dim ws As Worksheet
For Each ws In Workbook
If ws.Visible = xlSheetVisible Then
If ws.Name <> "Choose BU" Then ws.Delete
End If
Next ws
End Sub
It says "Object required", however I thought the worksheet per default is an object in VBA?
You could try:
Option Explicit
Sub test()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
With ws
If .Visible = True And .Name <> "Choose BU" Then
.Delete
End If
End With
Next ws
Application.DisplayAlerts = True
End Sub

There is a runtime error 91 on for loop

There is runtime error 91 on for loop need help!!
Sub clearSheet(WSName As String)
Dim ws As Worksheet
Set ws = Nothing
With ActiveWorkbook
Dim blWSExists As Boolean
blWSExists = False
For i = 1 To .Sheets.Count
If .Sheets(i).Name = WSName Then
blWSExists = True
.Sheets(i).Activate
.Sheets(i).Visible = xlSheetVisible
End If
Next
If Not blWSExists Then
Set ws = .Sheets.Add
ws.Move after:=.Sheets(.Sheets.Count)
ws.Name = WSName
ws.Visible = xlSheetVisible
End If
.Sheets(WSName).AutoFilterMode = False
.Sheets(WSName).Cells.Clear
.Sheets(WSName).UsedRange.ClearOutline
.Sheets(WSName).Cells.ClearFormats
End With
End Sub
Try that:
Dim ws As Worksheet
Dim blWSExists As Boolean
blWSExists = False
For Each ws In Worksheets
If ws.Name = WSName Then
blWSExists = True
End If
Next
If Not blWSExists Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = WSName
End If
Set ws = ActiveWorkbook.Sheets(WSName)
ws.AutoFilterMode = False
ws.Cells.Clear
ws.UsedRange.ClearOutline
ws.Cells.ClearFormats
ws.Activate
You can use Cells.Delete() to clear everything on a Worksheet:
Sub clearSheet(WSName As String)
Dim s As Object
For Each s in ThisWorkbook.Sheets
If s.Name = WSName Then
s.Visible = xlSheetVisible
If TypeOf s Is worksheet Then s.Cells.Delete ' not all Sheets have cells, but all Worksheets do
Exit Sub ' to ignore the rest of the code if the Sheet exists
End If
Next
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = WSName
End Sub
or just delete the sheet and add new to clear absolutely everything associated with the sheet:
Sub clearSheet(WSName As String)
On Error Resume Next
Sheets(WSName).Delete
Sheets.Add(After:=Sheets(Sheets.Count)).Name = WSName
End Sub

Syntax error on Paste Special from ThisWorkbook to new workbook

First line of code works fine, second errors out with a syntax error. I want it to do the same thing as first line except paste values only.
ThisWorkbook.Sheets(1).Range(Range("A4"), Range("A4").End(xlDown)).Copy .Sheets(1).Range("A1")
ThisWorkbook.Sheets(1).Range(Range("G4"), Range("G4").End(xlDown)).Copy .Sheets(1).Range("B1").PasteSpecial xlPasteValues
Full code for the sub
Private Sub CommandButton1_Click()
With Workbooks.Add
ThisWorkbook.Sheets(1).Range(Range("A4"), Range("A4").End(xlDown)).Copy .Sheets(1).Range("A1")
ThisWorkbook.Sheets(1).Range(Range("G4"), Range("G4").End(xlDown)).Copy .Sheets(1).Range("B1").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
.SaveAs "C:\Users\my username\Desktop\Macro Demo\output.xlsx"
Application.DisplayAlerts = True
.Close
End With
End Sub
Range("A4") and Range("A4").End(xlDown) may not belong to ThisWorkbook.Sheets(1) and you cannot define a range using cells from another worksheet.
Private Sub CommandButton1_Click()
Dim nwb As Workbook
Set nwb = Workbooks.Add
With ThisWorkbook.Sheets(1)
.Range(.Range("A4"), .Range("A4").End(xlDown)).Copy _
Destination:=nwb.Sheets(1).Range("A1")
With .Range(.Range("G4"), .Range("G4").End(xlDown))
nwb.Sheets(1).Range("B1").Resize(.Rows.Count, 1) = .Value
End With
End With
With nwb
Application.DisplayAlerts = False
.SaveAs "C:\Users\my username\Desktop\Macro Demo\output.xlsx"
Application.DisplayAlerts = True
.Close
End With
End Sub

Resources