In meinem Workbook mochte ich alle Sheets (ausser "Tabelle1" und "Tabelle3") die in den Bereichen A1:A20 sowie A30:A40 leer sind löschen.
Wie kann ich das mit einem makro machen?
Danke Gruss volker
Sub BlaetterLoeschen()
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
Select Case .Name
Case "Tabelle1", "Tabelle3"
'do nothing
Case Else
If Application.WorksheetFunction.CountA(.Range("A1:A20"), .Range("A30:A40")) = 0 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
End Select
End With
Next wks
End Sub
Sub BlaetterLoeschen()
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
Select Case .Name
Case "Holzliste", "Zeiten", "Laufkarte"
'do nothing
Case Else
If Application.WorksheetFunction.CountA(.Range("A8:A30"), .Range("A40:A61")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
End Select
End With
Next wks
End Sub
Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare
Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Sub DirAuswahl()
Dim sMsg As String, sPath As String
sMsg = "Wählen Sie bitte einen Ordner aus:"
sPath = getdirectory(sMsg)
If sPath <> "" Then MsgBox sPath
End Sub
Function getdirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
getdirectory = Left(Path, pos - 1)
Else
getdirectory = ""
End If
End Function