Hi guys,
So, I have this huge problem!!!
When I run a vba for deleting all worksheets except 3 specified ones the excel stop working and close. This is a test file so, I don't mind about data but it seems that I can't help it.
There are three main sheets, Master_Sheet,Monthly_Report and Default. As you'll see from the codes below, I use the Default sheet as a template for the sheets I create to enter the data.
So, find below all the coding I use. I'm an amateur with macro so, the coding I use you might find very no-sense.
I know it seems to much information but I guess for people like you it will be straight forward to understand.
If you have any idea why the file stop working when I use the
please let me know. Or if you have any idea how to correct the coding.
Thank you!!!
So, I have this huge problem!!!
When I run a vba for deleting all worksheets except 3 specified ones the excel stop working and close. This is a test file so, I don't mind about data but it seems that I can't help it.
There are three main sheets, Master_Sheet,Monthly_Report and Default. As you'll see from the codes below, I use the Default sheet as a template for the sheets I create to enter the data.
So, find below all the coding I use. I'm an amateur with macro so, the coding I use you might find very no-sense.
Code:
Private Sub CommandButton1_Click()Worksheets("Default").Copy After:=Worksheets(Worksheets.Count)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
'~~> Change CountLarge to Count if using xl2003
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("B2")) Is Nothing Then
Select Case Target.Value
Case Is = "": Rows("6:71").EntireRow.Hidden = True
Case Else: Rows("6:71").EntireRow.Hidden = False
End Select
End If
If Not Intersect(Target, Range("B2")) Is Nothing Then
Select Case Target.Value
Case Is = "Mobil": Rows("39:47").EntireRow.Hidden = True
End Select
End If
If Not Intersect(Target, Range("B2")) Is Nothing Then
Select Case Target.Value
Case Is = "Mobil": Rows("64:71").EntireRow.Hidden = True
End Select
End If
If Not Intersect(Target, Range("B2")) Is Nothing Then
Select Case Target.Value
Case Is = "Viva": Rows("33:38").EntireRow.Hidden = True
End Select
End If
If Not Intersect(Target, Range("B2")) Is Nothing Then
Select Case Target.Value
Case Is = "Viva": Rows("55:63").EntireRow.Hidden = True
End Select
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Address = "$E$8" And Range("E8") > 60 Then
Call SummurizeSheets
End If
If Target.Address = "$E$8" And Range("E8") > 300 Then
Call DeleteSheets1
End If
If Target.Address = "$E$8" And Range("E8") > 300 Then
Call CopySheet_End
End If
End Sub
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Not Intersect(Target, Range("A2:C14")) Is Nothing Then
Sh.Name = Sh.Range("B1").Value
End If
End Sub
Code:
Function sheetname(number As Long) As String sheetname = Sheets(number).Name
End Function
Code:
Sub DeleteSheets1() Dim xWs As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In Application.ActiveWorkbook.Worksheets
If xWs.Name <> "Master_Sheet" And xWs.Name <> "Monthly_Report" And xWs.Name <> "Default" Then
xWs.Delete
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Code:
Sub SummurizeSheets() Dim ws As Worksheet
Application.ScreenUpdating = False
Sheets("Monthly_Report").Activate
For Each ws In Worksheets
If ws.Name <> "Monthly_Report" And ws.Name <> "Master_Sheet" And ws.Name <> "Default" Then
ws.Range("B14").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("C14").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("B2").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("B4").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("D4").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("E4").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("A9").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 12).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("B9").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("C9").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 14).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("C12").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("D21").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("C23").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 17).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("D32").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 18).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("G12").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 19).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("H21").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 20).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("G23").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 21).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
ws.Range("H32").Copy
Worksheets("Monthly_Report").Cells(Rows.Count, 22).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End If
Next ws
End Sub
Code:
Sub CopySheet_End()Worksheets("Default").Copy After:=Worksheets(Worksheets.Count)
End Sub
I know it seems to much information but I guess for people like you it will be straight forward to understand.
If you have any idea why the file stop working when I use the
Code:
DeleteSheets1
Thank you!!!