löschen von leeren Spalten

Question

Hallo zusammen,

ich habe eine Quell Tabelle aus der ich Daten in meine Ziel Tabelle kopiere. Die ganze Tabelle ist dann 60 Spalten breit, die Tabelle hat Überschriften und die Anzahl der Zeilen ist aktuell nebensächlich.

Jetzt habe ich, mit meinem beschränktem Wissen versucht, die Spalten welche leer sind (außer die Überschrift) zu löschen. Es funktioniert ein bißchen und auch wieder nicht,

Zum einen sind, warum auch immer, die leeren Spalten nicht leer obwohl nix drin ist, bis ich das rausgefunden habe sind schon mal ca. 15 Stunden vergangen. :-)

Ich habe einmal meine Testdatei angehangen im Makro selbst sind ein paar Gedankengänge der letzten 15 Stunden vermerkt. :-)

In der Tabelle in B2 könnt ihr das Makro starten bis eben keine Zeile mehr da ist. Die letzte Spalte kommt dann eben nach vorne gewandert.

Löscht man aber den Inhalt der leeren Spalten außer Überschrift dann wird zumindestens schon mal vorne und hinten eine Zeile gelöscht.

Schön wäre es, wenn das alles in einem Rutscht passieren würde und Spalten als leer gesehen werden weil eben auch nix drin ist also rein optisch.

Vielleicht könnte hier jemand mal ein Auge drauf werfen und mit wieder einmal einen Tipp geben.

https://www.dropbox.com/scl/fi/k4zdat0tat3rjjg4e37wu/spalten_die_erste.xlsb?dl=0&rlkey=wgki2irbdkchrlbabfjwtyi87

Danke

energun222

Answer 1

Hallo,

kopiere das folgende Makro in ein allgemeines Modul deiner Arbeitsmappe:

Sub loeschen_neu()
Dim lngLSpalte As Long
Dim lngLZeile As Long
Dim lngSpalte As Long
Dim rngZelle As Range
Dim bNichtleer As Boolean

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'letzte beschriebene Spalte in Zeile 1 ermitteln
lngLSpalte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column

'Schleife zum Durchlaufen der Spalten; von letzter zu erster Spalte
For lngSpalte = lngLSpalte To 1 Step -1
  'letzte beschriebene Zeile in Spalte ermitteln
  lngLZeile = ActiveSheet.Cells(Rows.Count, lngSpalte).End(xlUp).Row
  'Marker für beschriebene Spalte zurücksetzen
  bNichtleer = False
  'Alle Zellen in Spalte ab Zeile 2 prüfen
  For Each rngZelle In Range(Cells(2, lngSpalte), Cells(lngLZeile, lngSpalte))
    If rngZelle.Value <> "" Then
      'falls Zelle nicht leer ist, dann Marker auf Wahr setzen
      bNichtleer = True
      'und Schleife verlassen
      Exit For
    End If
  Next rngZelle
 
  'Falls Spalte leer ist, dann diese Spalte löschen
  If bNichtleer = False Then Columns(lngSpalte).EntireColumn.Delete
 Next lngSpalte
 
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
 
End Sub

Das Makro wird immer auf die aktuell aktive Tabelle angewendet. Probiere es aber erst einmal in einer Testdatei aus.

Gruß

M.O.

Answer 2

Hallo M.O.

wieder mal herzlichen Dank für deine Mühe. Sowas kann man schon mal frühs zu Stande bringen. :-)

Das einzige was ich noch machen musste ist (weil Makro nacher aus anderem Sheet gestartet),  das ganze schön mit einer With Worksheets ("Tabelle2")  - end With einrahmen, 2 x ActiveSheet entfernen und 3 Punkte setzen. Funktioniert bestens.

Danke Dir

energun222