AW: Tipp
06.06.2024 16:03:25
Piet
Hallo
noch ein Tipp von mir. Liste doch bitte beide Dateien in meine Beispieldatei auf. Beide müssen geöffnet sein.
Das Löschmakro habe ich dir so umgeschrieben, das alle Zeile/Spalten in der xlsm Datei gelöscht werden, die außerhalb des UsedRange der xlsx Datei liegen. Damit stimmen die Dateien diesbezüglich schon mal überein. Im günstigsten Falle müsste sich dann das Volumen deutlich ändern.
Die Daten der xlsx Datei müssen in der Spalte B, C stehen. Der Tabellenname wird verglichen. Die Lastzell auf Spalte C berechnet.
mfg Piet
Sub xlsm_Bereiche_löschen()
Dim Bereich, j, lrw, Spa, LSP, lz1
Dim WbEx As Variant, UsAdr, Adr
If Workbooks(2).Name > ThisWorkbook.Name Then _
Set WbEx = Workbooks(2) Else Set WbEx = Workbooks(1)
LSP = WbEx.Sheets(1).Cells(1, Columns.Count).Address
LSP = Replace(LSP, "$1", "", xlPart)
With ThisWorkbook.Sheets(1)
lz1 = .Cells(200, 2).End(xlUp).Row
For j = 1 To lz1
If InStr(.Cells(j + 3, 3), ":") = 0 Then GoTo nx
If WbEx.Sheets(j).Name = .Cells(j + 3, 2) Then
UsAdr = .Cells(j + 3, 3).Value
Adr = Mid(UsAdr, InStr(UsAdr, ":") + 1)
Spa = Range(Adr).EntireColumn.Address(0, 0)
Spa = Left(Spa, InStr(Spa, ":") - 1)
rw = Range(Adr).EntireRow.Row + 1
If Spa = "A" Then Spa = "B"
WbEx.Sheets(j).Columns(Spa & ":" & LSP).Delete Shift:=xlToLeft
WbEx.Sheets(j).Rows(rw & ":" & Rows.Count).Delete Shift:=xlUp
Else
MsgBox "Sheetsname stimmt nicht überein"
nx: End If
Next j
MsgBox "xlsm gelöscht"
End With
End Sub