VBA Help, to Pick first Column Data and its file name

[malleshg24]

Hi Team,
I want to open each files from a folder and pick Column A Data (here id), and paste in (sheets 2) Under Column A.
and in column B, i want the file name paste till Column ("B2:B" & lr), Actually my colleague save file name as per date wise, like (08-Aug-2017) and so on.
So final result look like.
Confirm id Date.
45646 08-Aug - 2017
45789 08-aug - 2017
455645 09- aug - 2017. and so on. Here below is my code, it only pick up first column need help in picking file name in column B.

Sub ID_ColumnfromDifferentworkbook()
Dim wbk As Workbook
Dim sht As Worksheet, Nsht As Worksheet
    Application.ScreenUpdating = False
   
        FP = "E:\Software\Todays Report\"
        FN = Dir(FP)
       
    Set sht = Sheets.Add(, Sheets("Task"))
        sht.Name = "Master"
Do Until FN = ""
       
        lr = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
Set wbk = Workbooks.Open(FP & FN)
                    
    Set Nsht = wbk.Sheets(1)
        Nsht.Range("A1:A" & lr).Offset(1).Copy sht.Range("A" & lr)
    
        wbk.Close False
        
        FN = Dir
    Loop
        Set wbk = Nothing
      
    Application.ScreenUpdating = True
        
        MsgBox " Data consolodiate successfully !", vbInformation, "Data Import"
           
End Sub

[mdmackillop]

Give this a try

Option Explicit

Sub ID_ColumnfromDifferentworkbook()
    Dim wbk As Workbook
    Dim sht As Worksheet, Nsht As Worksheet
    Dim FP$, FN$
    Dim Lr&, Lrw&
    
    Application.ScreenUpdating = False
     
    FP = "E:\Software\Todays Report\"
    FN = Dir(FP & "*.xls*")
    Set sht = Sheets.Add(, Sheets("Task"))
    sht.Name = "Master"
    Do Until FN = ""
        Lr = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
        Set wbk = Workbooks.Open(FP & FN)
        Set Nsht = wbk.Sheets(1)
        Lrw = Nsht.Cells(Rows.Count, 1).End(xlUp).Row
        Nsht.Range("A1:A" & Lrw).Offset(1).Copy sht.Range("A" & Lr)
        sht.Range("A" & Lr).Offset(, 1).Value = FN
        wbk.Close False
        FN = Dir
    Loop
    Set wbk = Nothing
    Application.ScreenUpdating = True
    MsgBox " Data consolodate successfully !", vbInformation, "Data Import"
End Sub