View Single Post
  #1   Report Post  
Gaura215 Gaura215 is offline
Junior Member
 
Location: India
Posts: 24
Send a message via Skype™ to Gaura215
Smile Macro to generate FileName of the source file

Hello All

This is really urgent and appreciate all help in this regards.

I have been able to extract the relevant data from multiple files to my master sheet using the following code mentioned in this thread. And they are getting captured from coloumn B onwards which is exactly as per my requirements. Where I am stuck now is that, I am unable to understand the source file of the data from which it have been copied.
What I need now is that coloum A in each row reflects the full file name from where the data has been copied. So, I will have the source in coloum A from where Data in coloum B onwards have been copied from.

Hope I am able to explain it.

Following is the code I am currently using. Please please please help me!!

Sub AAA()
Dim FSO As Scripting.FileSystemObject
Dim FF As Scripting.Folder
Dim SubF As Scripting.Folder

Set FSO = New Scripting.FileSystemObject
Set FF = FSO.GetFolder("C:\Users\g.khanna\Desktop\Recons\Sp ain\")
For Each SubF In FF.SubFolders
DoOneFolder SubF
Next SubF
End Sub

Sub DoOneFolder(FF As Scripting.Folder)
Dim F As Scripting.file
Dim SubF As Scripting.Folder
Dim WB As Workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False

For Each F In FF.Files
Set WB = Workbooks.Open(F.Path)
' select data from open workbook
Sheets("Open items").Select
ActiveSheet.Unprotect Password:="trunte"
Range("A15000").Select
ActiveCell.FormulaR1C1 = "NON"
Range("A9:I9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("ADC Final.xlsm").Activate
Range("B2").Select
'find the next empty row
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
WB.Close SaveChanges:=False
Debug.Print F.Name
Next F

For Each SubF In FF.SubFolders
DoOneFolder SubF
Next SubF
End Sub
__________________
Regards
Gaurav