PDA

View Full Version : VBA Help, to Pick first Column Data and its file name



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

mdmackillop
08-25-2017, 04:48 AM
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