Sub InformationenEinfuegen()
Dim Zielmappe As Workbook
Dim QuellBlatt As Worksheet
Dim ZielBlatt As Worksheet
Dim strInhalt As String
Set Zielmappe = Workbooks.Open("F:\Sonstige\VBA-Foren\Test.xls"): DoEvents
With Zielmappe
For Each ZielBlatt In .Worksheets
If InStr(1, ZielBlatt.Name, "GM11_6-", vbBinaryCompare) <> 0 Then
strInhalt = ZielBlatt.Range("B5")
With ThisWorkbook
For Each QuellBlatt In .Worksheets
With QuellBlatt
If .Range("C1") = strInhalt Then
.Range("B6:I13").Copy ZielBlatt.Range("B22")
.Range("B16:Q21").Copy ZielBlatt.Range("B32")
End If
End With
Next
End With
End If
Next
End With
Set Zielmappe = Nothing
End Sub