Ich habe mir mit Hilfe dieses Forums ein Makro zusammengebaut, das nach bestimmten Begriffe USA in offenen Mappen (1-8)durchgesucht sein sollte.
In eine BeispielMappe.xlsm befindest sich der Makro InoffenenMappenSuchen (s.u.).
Der InoffenenMappenSuchen Makro sucht in allen offenen Mappen den Begriff USA.
Such Begriff kann nur einmal vorkommen und der befindet sich immer in B2 in irgend eine Mappe von 1 bis 8 (es sollen nur die Tabellen 1 durchgesucht werden).
Wenn der USA in B2 gefunden wurde dann soll der Tabellen Inhalt A1:C400 (wo der USA Begriff steht) nach Ziel Tabelle usa-tabelle ins BeispielMappe.xlsm kopiert werden.
Das funktioniert soweit einwandfrei.
Der Problemm habe ich mit Ziel Tabellen. Jeder gesuchte bzw. gefunden Suchbegriff (ist immer in Tabellen 1 in "B2") aber jeder Suchbegriff hat seine Ziel Tabelle.
Also alle andere Suchbegriffe (für meine weiteren separate Makros) werden eine andere Ziel Mappe haben.
Wenn ich das gleiche Makro für einen anderen Begriff als Beispiel ASIEN benutze. Dabei verändere ich den Makro Name InoffenenMappenSuchenASIEN und die Call Insert Data ins InsertDataAsien. Alles ist das gleiche wie in unteren Code nur die Ziel Tabelle in "BeispielMappe.xlsm" ist dann asien-tabelle.
Also wenn ich in Anweisung statt rng.Value = Wb.Worksheets(1).Range(rng.Address).Value neu benne ins
rng.Value = Wb.Worksheets(asien-tabelle).Range(rng.Address).Value da become ich immer Fehlermeldung.
Da komme ich leider nicht weiter.
Ich hab von VBA nicht soviel Ahnung, da ich Anfänger in VBA Welt bin.
Ich kann hier im Forum sicher nichts beitragen außer Fragen, würde mich aber sehr freuen, wenn mir jemand ein Hinweis geben kann.
Ich danke Euch für Euer Hilfe.
Gruß
Daniel
Sub InoffenenMappenSuchen()
Dim arr As Variant
Dim iArr As Variant
arr = Array("USA")
For iArr = LBound(arr) To UBound(arr)
Call InsertData(CStr(arr(iArr)))
Next iArr
End Sub
Private Sub InsertData(sTxt As String)
Dim Wb As Workbook
Dim wks As Worksheet
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("USA").Range("A1:C400")
For Each Wb In Workbooks
If Wb.Name ThisWorkbook.Name Then
If Wb.Worksheets(1).Cells(2, 2).Value = "USA" Then
rng.Value = Wb.Worksheets(1).Range(rng.Address).Value
Workbooks("BeispielMappe.xlsm ").Activate
Sheets("usa-tabelle").Select
Range("A1").Select
Range("A1").Formula = "xy"
Range("B1").Formula = "x"
Range("C1").Formula = "y"
Range("D1").Formula = "ab"
Range("E1").Formula = "bcde"
Range("A1:E1").Interior.ColorIndex = 33
With Range("A1:E1")
With .Borders(xlEdgeLeft)
.Weight = xlMedium
End With
With .Borders(xlEdgeTop)
.Weight = xlMedium
End With
With .Borders(xlEdgeBottom)
.Weight = xlMedium
End With
With .Borders(xlEdgeRight)
.Weight = xlMedium
End With
End With
Workbooks("BeispielMappe.xlsm ").Activate
Sheets("usa-tabelle ").Select
Columns("A:E").EntireColumn.AutoFit
Exit For
End If
End If
Next Wb
End Sub