malleshg24
08-24-2017, 10:16 PM
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:help
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
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:help
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