Sub data_transfer()
 
    Dim File As String
    Dim xApp As Object
 
    File = Application.GetOpenFilename("Excel Files, *.xls*")
    If File = "False" Then Exit Sub
    Set xApp = CreateObject("Excel.Application")
    xApp.Visible = True
    xApp.Workbooks.Open File
 
 
Dim i As Integer
 
 
For i = 1 To 4000
Workbooks("makro.xlsm").Worksheets("List1").Range("A" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("A" & i).Value
Workbooks("makro.xlsm").Worksheets("List1").Range("B" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("B" & i).Value
Workbooks("makro.xlsm").Worksheets("List1").Range("C" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("C" & i).Value
Next i
 
End Sub