Hallo ,

Ich habe aktuell einen VBA Code, der leider noch einen Fehler enthält und ich leider nicht weiterkomme.

Folgendes Problem soll mit dem Code gelöst werden:

Es sind 2 Tabellen vorhanden (2 Sheets in einem Excel Dokument) und hierbei sollen von beiden Tabellen jeweils die Spaltennamen miteinander verglichen werden und falls es Spalten gibt, die nur in einer Tabelle vorkommen, dann sollen diese ausgeschnitten werden und in ein neues Sheet eingefügt werden. Das Ergebnis sind somit 2 Tabellen (2 Sheets) mit nur gleichen Spalten (Also quasi die Schnittmenge beider Tabellenspalten).

Mein genaues Problem:

Es funktioniert alles, bis auf eine einzige Sache. Immer wenn eine Spalte gefunden wird und anschließend entfernt, werden soll, so wird diese entfernt und alle nachkommenden Spalten rutschen dann ja nach links. Dadurch wird in der For-Schleife ein „Durchgang“ (ein i) übersprungen.

Das heißt, wenn eine Spalte tatsächlich gelöscht wird, so müsste nach diesem Zeilencode...

Worksheets("NewTab").Columns(i).EntireColumn.Delete

...das i aus der For-Schleife um 1 steigen, damit nicht ein Schleifendurchgang übersprungen wird. Alles andere funktioniert hervorragend. Ich hoffe es ist verständlich was ich damit meine.

Könnt ihr mir da weiterhelfen? Ich danke euch vielmals für jede Hilfe.

Hier ist der Codeausschnitt. Falls ich das ganze Excel-Dokument hochladen soll, so kann ich das gerne machen.

OldTab = Tabelle 1

NewTab = Tabelle 2

NeueSpalten = Tabelle 3 für die ausgeschnittenen Spalten

Codeausschnitt:

For i = 1 To LetzteSpalteUpda

    Worksheets("NewTab").Activate

    Suchdatum = Worksheets("NewTab").Cells(1, i).Value

    Worksheets("OldTab").Activate

    Set Ergebnis2 = Worksheets("OldTab").Range(Cells(1, 1), Cells(1, 500)).Find(What:=Suchdatum, LookIn:=xlValues)

   
    If Ergebnis2 Is Nothing Then


        Worksheets("NeueSpalten").Activate

        intLetzteSpalte = Worksheets("NeueSpalten").Cells(1, Columns.Count).End(xlToLeft).Column

        Worksheets("NewTab").Columns(i).Copy _

        Destination:=Worksheets("NeueSpalten").Cells(1, intLetzteSpalte + 1)

      
        Worksheets("NewTab").Columns(i).EntireColumn.Delete

    Else

    End If   

    Next   

    Worksheets("NeueSpalten").Columns(1).EntireColumn.Delete

End Sub