ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Macro for updating the filename along with data (https://www.excelbanter.com/excel-discussion-misc-queries/449531-macro-updating-filename-along-data.html)

Gaura215

Macro for updating the filename along with data
 
Hi All Excel Gurus

I have a macro, to copy data from several files to my master workbook.

However, the data is of similar nature in all those workbooks, so it becomes difficult for me to identify the file from which data has been copied from.

Is there a way, that when the data is being pasted in master workbook, in coloum A of all rows which have been copied reflects the full filename?

Any help in this would be highly appreciable.

[email protected]

Macro for updating the filename along with data
 
Hi Gaura215,

The below piece of command may be solve your problem

dim i as double, wks as worksheet
i = wks.Cells(Rows.Count, "b").End(xlUp).Row
wks.Range("a1:a" & i).Value = Application.ActiveWorkbook.Path & "\" & ActiveWorkbook.Name


Gaura215

thanks a lot for your help, please can you advice me where I should insert it in my code?

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

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("A2").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


All times are GMT +1. The time now is 04:40 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com