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
|