VBA na kopírování dat z více souborů

[mejlacz05]

Zdravím, potřeboval bych helfnout s jedním makrem.

Option Explicit

Sub SloucitData()
Dim MsgResponse As Byte
Dim objFSO As Object, objDir As Object, aItem As Object
Dim CntFFile As Integer, SPath As String, SFileType
Dim Swbk As Workbook, SWsht As Worksheet, SCll As Range
Dim SWshtName As String, SCllAddr As String
Dim TWbk As Workbook, TWsht As Worksheet, TCllAddr As String
Dim TCll As Range, TOffsR As Long, TWshtName As String

'*********upravit dle realu**********
SPath = "E:\Excel\dodov" ' katalog zdrojovych sesitu
SFileType = "xlsx" ' rozsireni .xlsx
' nazev listu a vychozi bunka
SWshtName = "list1" ' zdrojovych sesitu
SCllAddr = "c6"
TWshtName = "list1" ' ciloveho sesitu
TCllAddr = "c8"
'************************************

' v katalogu otevirat jednotlive soubory, prenest data
' definovat objekt FSO
Set objFSO = CreateObject("scripting.filesystemobject")
On Error Resume Next
' katalog
Set objDir = objFSO.GetFolder(SPath)
If Err.Number <> 0 Then
MsgResponse = MsgBox("Katalog zdrojových souborù nebyl nalezen." & vbCr _
& "Konec.", vbOKOnly + vbExclamation)
GoTo Err3
End If
On Error GoTo 0
' pocet souboru
CntFFile = objDir.Files.Count
' pokud CntFFile=0, zobrazi hlasku
If CntFFile > 0 Then
' definovat cilovy sesit, list, vychozi bunku, offset
Set TWbk = ThisWorkbook
Set TWsht = TWbk.Worksheets(TWshtName)
Set TCll = TWsht.Range(TCllAddr)
TOffsR = 0
' ve smycce otevirat zdrojove sesity
For Each aItem In objDir.Files
If objFSO.GetExtensionName(aItem) = SFileType Then
' definovat zdrojovy sesit, list, vychozi bunku
Set Swbk = GetObject(aItem)
Set SWsht = Swbk.Worksheets(SWshtName)
Set SCll = SWsht.Range(SCllAddr)
' prenest data
TCll.Offset(TOffsR, 0).Value = SCll.Value
TCll.Offset(TOffsR, 2).Value = SCll.Offset(1, 0).Value
TCll.Offset(TOffsR, 4).Value = SCll.Offset(2, 0).Value
Swbk.Close False ' zavrit zdrojovy sesit
Set SCll = Nothing
Set SWsht = Nothing
Set Swbk = Nothing
TOffsR = TOffsR + 1
End If
Next aItem
With Application
.DisplayAlerts = False
TWbk.Save ' ulozit cilovy sesit
.DisplayAlerts = True
End With
Else ' nebyl nalezen zadny soubor
MsgResponse = MsgBox("Katalog zdrojových souborù: '" & SPath & "' je prázdný!", _
vbOKOnly + vbInformation)
End If
Set TCll = Nothing
Set TWsht = Nothing
Set TWbk = Nothing
Err3:
Set aItem = Nothing
Set objDir = Nothing
Set objFSO = Nothing
End Sub


Tohle jsem si našel na netu, nicméně neufunguje to jak má. Já bych potřeboval, aby to vzalo celý řádek, od buňky A2 do konce, zkopíroval do otevřeného sešitu do buňky A2, a hned pod to zase data od A2 z dalšího souboru z dané složky. Uměl by někdo poradit, co přesně změnit?