Importmakro mit Löschen von Tabellenblättern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo! Hier dann mal eine Variante. Dabei werden die Blattnamen (die bleiben sollen) immer erst noch abgefragt. Da wo es im Code steht, noch anpassen, insb. dem Pfad. VG Matthias


Sub blätter_löschen()
Dim i As Long
Dim j As Long
Dim wb As Object
Dim pfad As String
Dim blattname As String
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Wählen Sie die zu bearbeitenden Dateien aus:"
.InitialView = msoFileDialogViewDetails
.AllowMultiSelect = True
.InitialFileName = Application.Path & "*.xls; *.xlsx; *.xlsm"
.InitialFileName = "C:\Users\ich\Desktop"  'anpassen
.Filters.Add "Exceldaten", "*.xls; *.xlsx; *.xlsm", 1 'ggf anpassen oder rausnehmen
If .Show Then
For i = 1 To .SelectedItems.Count
pfad = .SelectedItems(i)
name = Right(pfad, InStr(1, StrReverse(pfad), "\") - 1)
blattname = InputBox("Name des Blattes welches in " & name & " bleiben soll.", " _
Blattname")
Application.DisplayAlerts = False
Set wb = Workbooks.Open(pfad)
For j = wb.Worksheets.Count To 1 Step -1
If wb.Worksheets(j).name  blattname Then wb.Worksheets(j).Delete
Next j
wb.Close savechanges:=True
Application.DisplayAlerts = True
Next i
End If
End With
Application.ScreenUpdating = True
End Sub

Hallo Bernd
ich zwei interessante Entdeckungen gemacht, über die ich verblüfft bin, eine aber technisch nicht erklaeren kann!
Einmal ein dummer Flüchtigkeitsfehler im Code, und zwar im: - CommandButton1_Click. Aendere es bitte wie unten.
Bei dir steht als Variable Blatt statt UFBlatt, und man sollte den Code stoppen wenn keine Liste gewaehlt wurde!
Der zweite Effekt ist, befinden sich in der Datei Module funktioniert bei mir das Löschen nicht mehr!
Ich weiss aber nicht warum das so ist? - Wenn du keine Module in der Datei drin hast ist das ja egal!
mfg Piet

Private Sub CommandButton1_Click()
UFBlatt = UserForm1.ListBox1.Text
If UFBlatt = Empty Then MsgBox "Kein Blatt ausgewählt!!": Exit Sub
Call Löschen_über_UserForm
End Sub

'umgeschrieben 17.6.2017 'Probleme mit alten Dateien in denen Modul Blaetter sind!! Sub Löschen_über_UserForm() Dim f, j As Integer If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub On Error Resume Next 'Löschwarnung abschalten Application.DisplayAlerts = False UFBlatt = UserForm1.ListBox1.Text 'alle Blaetter Löschen ausser Blatt For j = ActiveWorkbook.Worksheets.Count To 1 Step -1 If Worksheets(j).Name UFBlatt Then Worksheets(j).Delete If Err > 0 Then f = f + 1: Err = Empty: MsgBox "Err " & Err Next j 'Löschwarnung wieder einschalten Application.DisplayAlerts = True If f > 0 Then MsgBox f & " unerwarteter Fehler" Unload UserForm1 End Sub

Beliebteste Forumthreads (12 Monate)

Importmakro mit Löschen von Tabellenblättern

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Importmakro mit Löschen von Tabellenblättern

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread