Hallo Karl-Heinz,

habe heute Dein Makro perfekt anwenden können. Das hat mich sehr gefreut, dass das so super geklappt hat. Unten habe ich mein angepasstes Makro. Drei Fragen hätte ich aber noch dazu. Vielen, vielen Dank schon mal!!!

1. Const csSpalten As String = "A1,F1,B1,G1,H1,C1,AC1,AA1,U1,V1,AH1,AI1" ---> Das sind die Spalten in der Quelldatei. Diese bräuchte ich in dieser Reihenfolge auch in der Zieldatei. Dort dann in A,B,C ... Leider werden die Quell-Spalten aber alphabetisch angeordnet.

2. With Ziel.Cells(Ausgabe_Zeile, "E")                                            ---> Kann man das auch zusammenfassen? Habe mehrere solche Änderungen.

   .Value = Replace(.Value, "Oktoberfest", "OF")

        End With

        With Ziel.Cells(Ausgabe_Zeile, "F")

            .Value = Replace(.Value, "Fischmarkt", "FM")

        End With

3. Spalte_Suchen = Ziel.Buttons(Application.Caller).Caption ---> kann man nur nach einem Begriff suchen lassen? Geht es auch, nach z. B. München und Hamburg zu suchen, damit alles von München und Hamburg in einem Datenblatt zusammengefasst wird?

Option Explicit '<<<Variablen manuell deklarieren >>>

Sub Sehenswürdigkeiten()

' <<< Nur über Schaltfläche aktivieren! >>>

    Dim Objekt_Finden As Object

    Dim Spalte_Suchen As String, Spalte_Erste_Adresse As String, Ausgabe_Zeile As Long

    Dim Ziel As Worksheet, Quelle As Worksheet

' <<< Spalten in der Quelldatei >>>

    Const csSpalten As String = "A1,F1,B1,G1,H1,C1,AC1,AA1,U1,V1,AH1,AI1"

' <<< Stammdatendatei öffnen >>>

    Workbooks.Open ("E:\Stammdaten.xlsx")

' <<< Quell- und Zielblatt setzen >>>

    Set Quelle = Worksheets("Datenerfassung")

    Set Ziel = ThisWorkbook.Sheets("München")

' <<< Daten in Zieldatei löschen >>>

    Ziel.Range("A23:L82").ClearContents

' <<< Text aus Button als Suchbegriff festlegen >>>

    Spalte_Suchen = Ziel.Buttons(Application.Caller).Caption

    If Spalte_Suchen = "" Then Exit Sub

' <<< Erste Ausgabezeile in der Zieldatei >>>

    Ausgabe_Zeile = 22

' <<< Erstes Feld mit Suchbegriff suchen >>>

    Set Objekt_Finden = Quelle.Range("E:E").Find(Spalte_Suchen, LookIn:=xlValues, LookAt:=xlWhole)

'<<< Ziel Ausgabe ab Spalte >>>

    If Not Objekt_Finden Is Nothing Then

             Spalte_Erste_Adresse = Objekt_Finden.Address

        Do

            Ausgabe_Zeile = Ausgabe_Zeile + 1

            Quelle.Range(Replace(csSpalten, "1", Objekt_Finden.Row)).Copy _

            Ziel.Cells(Ausgabe_Zeile, "A")

' <<< Ersetze Begriff von Quellblatt in Zielblatt durch anderen Begriff >>>

        With Ziel.Cells(Ausgabe_Zeile, "E")

            .Value = Replace(.Value, "Oktoberfest", "OF")

        End With

        With Ziel.Cells(Ausgabe_Zeile, "F")

            .Value = Replace(.Value, "Fischmarkt", "FM")

        End With

' <<< Schleife für nächsten Suchbegriff >>>

        Set Objekt_Finden = Quelle.Range("E:E").FindNext(Objekt_Finden)

            If Objekt_Finden Is Nothing Then Exit Do

            Loop While Not Objekt_Finden Is Nothing And Objekt_Finden.Address <> Spalte_Erste_Adresse

        End If

    Workbooks("Stammdaten.xlsx").Close

    Ziel.Activate

End Sub