Hallo zusammen,

ich habe ein etwas komplexeres Problem.

In einem Ordner sind zwei Excel Dateien abgespeichert. 

Datei a ist die Quelldatei, in der ca. 200 Tabellenblätter integriert sind. 

Datei b ist die Zieldatei, die auch mehrere Tabellenblätter hat.

Ziel ist es, Werte diverser Zellbereiche von der Quelldatei in die Zieldatei zu kopieren. Bisher habe ich dies immer per Copy and Paste erledigt.

Ich befinde mich in der Zieldatei. Hier gibt es viele Tabellenblätter von denen einige mit dem Namen "GM11_6-xx" bezeichnet sind. xx steht jeweils für ie Zahlen 1-99.

Nun möchte ich von in alle Tabellenblätter, die mit dem Namen "GM11_6" beginnen nacheinander Werte in spezielle Zellbereiche einfügen.

Dazu kopiere ich mir den Namen der jeweils in der Zelle "B5" eines Tabellenbaltts "GM11_6-xx" eingetragen ist und suche nach diesem Namen über alle Tabellenblätter in der Quelldatei a. 

Wenn ich das entsprechende Tabellenblatt über die Suchfunktion gefunden habe, kopiere ich jeweils die Werte von "B6:I13" und "B16:Q21" der Quelldatei in die Zellen "B22" und "B32" der Zieldatei.

Die Anzahl der Tabellenblätter in der Zieldatei mit den Namen "GM11_6-xx" variieren von 5-30. Somit ist man ggf. einige Zeit mit dem Copy und Paste beschäftigt. 

Dieses Problem möchte ich nun über ein Makro lösen.

Leider sind meine Kenntnisse nicht so weit fortgeschritten, sodass ich nun bei dem angehängten Makro nicht mehr weiterkomme.

Kann mir von Euch jmd. behilflich sein? Ich hoffe ich liege nicht ganz so daneben mit dem MAkro.

Vielen Dank im Voraus.

Sub InformationenEinfuegen()

Workbooks.Open "C:\b"
    
    Dim Quelle As Workbook
    Set Quelle = ThisWorkbook
    Dim Zielmappe As Workbook
    Set Zielmappe = Workbooks "C:\b"
    Dim i As Integer
    Dim Blatt As Worksheet

    Set Blatt = Blatt + i

With Zielmappe

For Each Blatt In Zielmappe.Worksheets

    If Blatt.Name = "GM11_6-**" Then
           Range("B5").Copy
     Quelle.Activate
      Cells.Find(What:= _
         "Value.Range("B5"), After:= _
          ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
          SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
      Range("B6:I13").Select
          Selection.Copy
           Zielmappe.Activate
       Range("B22").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
          Quelle.Activate
       Range("B16:Q21").Select
            Selection.Copy
           Zielmappe.Activate
        Range("B32").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If

    Next Blatt
    
End With
End Sub