Nach langer Zeit habe ich im Archive von Herber, ein Code gefunden womit ich ein Teil meines Zieles erreichen kann. Mappen öffnen mittels eine Liste.
Option Explicit
Sub Readfiles()
Dim iCounter As Integer
With Application.FileSearch
.LookIn = Range("B1").Value
.Filename = "*.xls"
.Execute
For iCounter = 1 To .FoundFiles.Count
Cells(iCounter + 1, 1).Value = Dir(.FoundFiles(iCounter))
Next iCounter
End With
End
Sub
Option Explicit
Sub openfiles()
Dim wks As Worksheet
Dim iRow As Integer
Dim sPath As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wks = ActiveSheet
iRow = 1
sPath = Range("B1").Value
On Error GoTo ERRORHANDLER
Do Until IsEmpty(wks.Cells(iRow, 1))
iRow = iRow + 1
If LCase(wks.Cells(iRow, 2).Value) = "x" Then
Workbooks.Open sPath & "\" & wks.Cells(iRow, 1).Value, False
End If
Loop
ERRORHANDLER:
Application.EnableEvents = True
Application.ScreenUpdating = True
End
Sub
Jetzt brauchte ich zusätzlich noch eine Schleife die es ermöglicht in alle vom Code geöffnete Mappen, Daten von der Mappe "Main" Worksheet("Data").Range("A1:D1), dort in den Zellen vom Worksheet("Input").range("E1:E4")einzufügen.(Transpose?) Nachdem die Daten eingefügt würden, müsste in jede einzelne Mappe auch wieder Daten kopiert werden (Range("D1:D4")um anschliessend in der Mappe "Main" eingefügt zu werden. Nachher müsste der Code wiederum Daten von der Mappe "Main" Worksheet("Data").Range("A2:D2), in den Zellen Worksheet("Input").range("E1:E4") einfügen und kopieren.(Schleife) usw....!
Hört sich alles sehr kompliziert an und ist es auch für mich. Hoffentlich könnt ihr mich weiter helfen oder jedenfalls hinweise geben!
Grüsse
Robert