Hallo zusammen,

ich habe ein Programm geschrieben, das Inhalte einer Arbeitsmappe untereinander in eine Spalte einer anderen kopiert. Zu Beginn wird abgeprüft, ob die Überschrift ("Suche") bereits vorhanden ist. Ist dies der Fall wird die Frage ausgegeben, ob die Daten überschrieben werden sollen oder nicht. Falls die Daten nicht überschrieben werden sollen, oder die Überschrift noch nicht vorhanden ist, wird die nächste freie Spalte gesucht und dort hineinkopiert.

Das Problem, das ich gerade habe ist, dass bei existierender Überschrift und positiver Beantwortung der "Überschreiben?"-Frage die Zellen nicht überschrieben werden.

Sieht jemand den Fehler in meinem Programm?

Dim existiert As Boolean
    existiert = False
    Dim Suche As String
    Suche = ActiveSheet.Range("B1")
    Worksheets("Vergleich").Select
    Range("A2").Select

' ...Zellen A2 bis A22 vergleichen...    
    For i = 1 To 20
        If ActiveCell <> Suche Then ActiveCell.Offset(0, 1).Select Else existiert = True
    Next i

' ...Abfrage ob die Spalte überschrieben werden soll...       
    If existiert = True Then
        If MsgBox("" & Suche & " existiert bereits. Überschreiben?", vbYesNo) = vbNo Then
            Worksheets("Vergleich").Select
                Range("A2").Select
                For i = 1 To 20
                    If ActiveCell.Value <> "" Then ActiveCell.Offset(0, 1).Select Else Exit For
                Next i
        Else: ActiveCell.Select
        End If
    End If

' ...freie Spalte finden...                
    If existiert = False Then
        Worksheets("Vergleich").Select
                Range("A2").Select
                For i = 1 To 20
                    If ActiveCell.Value <> "" Then ActiveCell.Offset(0, 1).Select Else Exit For
                Next i
    End If

' ...jetzt folgt das kopieren der Daten...
For Each Zelle In Quelltab1.Range("B1:B23")
        Zieltab.Cells(Zaehler, i) = Zelle
        Zaehler = Zaehler + 1
Next Zelle

Danke!