Bu kodda başlıklarla birlikte alır verileri.
Kolay gelsin.

Sub GetData()



Dim sFile As Workbook, tFile As Workbook

Dim dosya As String, kes, parcaAl

Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet



Set tFile = ThisWorkbook

Set s1 = tFile.Sheets("Senelik Mazeret")

Set s2 = tFile.Sheets("Dr.Raporlu Sevk")

Set s3 = tFile.Sheets("Ücretsiz")



Application.ScreenUpdating = False

    dosya = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.*")

    s1.Cells.ClearContents: s2.Cells.ClearContents: s3.Cells.ClearContents

        Do While dosya <> ""

            If dosya <> ThisWorkbook.Name Then

                Set sFile = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & dosya)

                kes = Split(dosya, ".")

                parcaAl = Mid(dosya, 1, Len(dosya) - Len(kes(UBound(kes))) - 1)

                If parcaAl = "Liste1(Senelik Mazeret)" Then

                    sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Copy s1.Cells(1, 1)

                ElseIf parcaAl = "Liste2(Dr.Raporlu Sevk)" Then

                    sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Copy s2.Cells(1, 1)

                ElseIf parcaAl = "Liste3(Ücretsiz)" Then

                    sFile.Worksheets("Sayfa1").Range("A1").CurrentRegion.Copy s3.Cells(1, 1)

                End If

                kes = "": sFile.Close

            End If

            Application.CutCopyMode = False

            dosya = Dir

        Loop

    Application.ScreenUpdating = True

    s1.Activate

    s1.Cells(1, 1).Activate

    MsgBox "Bitti"

    Set sFile = Nothing: Set tFile = Nothing: parcaAl = vbNullString

    Set s1 = Nothing: Set s2 = Nothing: Set s3 = Nothing

End Sub