Sub ImportDataFromMultipleWorkbooks()



    Dim vaFiles As Variant

    Dim wbkToCopy As Workbook

    Dim ws As Worksheet

    Dim wsa As Worksheet

    Const sonSutunNo As Byte = 9

    Const ilBosksatirNo As Byte = 3

    Dim bulSatirNo As Range, bulSutunNo As Range

    Dim i As Long, son As Long, k As Byte

    

    ThisWorkbook.Activate

    

    Set ws = ThisWorkbook.Sheets("Sayfa1")

    

    un = "Sayýn " & Environ("UserName")

    

    ms1 = MsgBox("Birden fazla dosyadan veri almak istiyor musunuz?", vbInformation + vbYesNo, un)

    If ms1 = vbYes Then

        ws.Range(ws.Cells(ilBosksatirNo, 1), ws.Cells(Rows.Count, sonSutunNo)).ClearContents

        ws.Range(ws.Cells(ilBosksatirNo, 1), ws.Cells(Rows.Count, sonSutunNo)).Borders.LineStyle = xlNone

        ChDir (ThisWorkbook.Path)

        vaFiles = Application.GetOpenFilename( _

        FileFilter:="Microsoft Excel Workbooks(*.xls;*.xlsx;*.xlsb;*.xlsm),*.xls;*.xls;*.xlsx;*.xlsb;*.xlsm", _

        Title:="Select Files to Proceed", MultiSelect:=True)

        

        With Application

            .DisplayAlerts = False

            .ScreenUpdating = False

        End With

        

        If IsArray(vaFiles) Then

            For i = LBound(vaFiles) To UBound(vaFiles)

                If vaFiles(i) = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name Then

                    ms4 = MsgBox("Cannot Open Itself", vbExclamation, un)

                    GoTo skipfile:

                End If

                

                Set wbkToCopy = Workbooks.Open(Filename:=vaFiles(i))

                Set wsa = ActiveWorkbook.ActiveSheet

                Set bulSatirNo = wsa.Range("A:A").Find(ws.Range("A2").Value, , , 1)

                Set bulSutunNo = wsa.Rows(2).Find(ws.Range("i2").Value, , , 1)

                

                If Not bulSatirNo Is Nothing And Not bulSutunNo Is Nothing Then

                    son = wsa.Cells(Rows.Count, 2).End(3).Row

                    If son >= bulSatirNo.Row Then

                        wsa.Range(wsa.Cells(bulSatirNo.Row + 1, 1), wsa.Cells(son, bulSutunNo.Column)).Copy

                        ws.Range("A" & Rows.Count).End(3)(2, 1).PasteSpecial xlPasteValuesAndNumberFormats

                    End If

                End If

                Set bulSatirNo = Nothing

                Set bulSutunNo = Nothing

                wbkToCopy.Close savechanges:=False

skipfile:

            Next i

            ws.Range("A:K").EntireColumn.AutoFit

            ms5 = MsgBox("Verileriniz ana dosyaya aktarýlmýþtýr", vbInformation, un)

        Else

            ms3 = MsgBox("Dosya seçmediniz!", vbExclamation, un)

        End If

    Else

        ms2 = MsgBox("Baþarýsýz!", vbInformation, un)

    End If

    If WorksheetFunction.CountA(ws.Range("A2:A" & Rows.Count)) > 0 Then

        son = ws.Range("A" & Rows.Count).End(3).Row

        ws.Range(ws.Cells(ilBosksatirNo, 1), ws.Cells(son, sonSutunNo)).Borders.LineStyle = 1

    End If

    With Application

        .DisplayAlerts = True

        .ScreenUpdating = True

    End With



End Sub