Mappen öffnen, Daten einfügen und kopieren

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