Copy filename to inserted row


Well-known Member
Jun 5, 2011
Hi All,

I have 31 files in a folder naming such as "20111002 Daily Performance",
"20111003 Daily Performance", "20111004 Daily Performance" and so on.

Now I need to copy all the files in a single workbook on sheet1 and I am able to do it with the help of a macro but the problem is I don't need to copy the files containing data for saturday and sunday. that means I only want to copy the files for working days that is monday to friday. ( I think weekday can be calculated by the date in the filename)

Need a macro for this.

Second problem is after copying a single file I need to insert a column at the beginning of the data where I want to enter the date ( date should be same as the date in filename)
for example : - I want to copy "20111002" from the file name "20111002 Daily Performance" after copying the data from this file. It should be in mm/dd/yyyy format.

STEP 1: - copy the data from a file into a single workbook ( this is for reference, don't need help on this)

STEP 2: - after copying the data want to insert a column at the beginning of the data as column A ( want help on this)

STEP 3: - In column A(that we have inserted in step 2) want date from the file name in mm/dd/yyyy format

Note: - Don't want to copy the data for saturday and sunday.

This is a very critical task for me. I tried a lot but unable to perform the complete task.Need your help!

Thanks in advance!

Last edited:

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
I think I have solved part of this. Hope this gives you a start.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> FileName02()<br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">' FileName02 Macro By Xtremegrump</SPAN><br><SPAN style="color:#007F00">'</SPAN><br><br><SPAN style="color:#007F00">'</SPAN><br>    Windows("20111004.xlsx").Activate<br>    Rows("1:1").Select<br>    Selection.Insert Shift:=xlDown<br>    Range("B1").Select<br>    Application.Run "'Filename Macro.xlsm'!FileName"<br>    Range("A1").Select<br>    Selection.Copy<br>    Windows("Filename Macro.xlsm").Activate<br>    Range("A1").Select<br>    ActiveSheet.Paste<br>    Range("B1").Select<br>    Windows("20111004.xlsx").Activate<br>    Rows("1:1").Select<br>    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br>    Selection.Delete Shift:=xlUp<br>    Range("B1").Select<br>    Windows("Filename Macro.xlsm").Activate<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><SPAN style="color:#00007F">Sub</SPAN> CopyFile()<br><SPAN style="color:#007F00">'</SPAN><br><SPAN style="color:#007F00">' CopyFile Macro By Xtremegrump</SPAN><br><SPAN style="color:#007F00">'This will copy the data from column A and paste it into Column A of different workbook</SPAN><br><br><SPAN style="color:#007F00">'</SPAN><br>    ChDir "C:\Users\Kevin Millen\Desktop"<br>    Workbooks.Open FileName:="C:\Users\Kevin Millen\Desktop\20111004.xlsx"<br>    Range("A1").Select<br>    Range(Selection, Selection.End(xlDown)).Select<br>    Selection.Copy<br>    Range("B1").Select<br>    Windows("Filename Macro.xlsm").Activate <SPAN style="color:#007F00">' Change filename as needed</SPAN><br>    ActiveSheet.Paste<br>    Rows("1:1").Select<br>    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br>    Selection.Insert Shift:=xlDown<br>    Range("B1").Select<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
Upvote 0
' I see you have a good start..

‘Hope this helps

‘Here are three routines:

‘Insert a first col
Sub InsertColA()
Columns("A:A").Insert Shift:=xlToRight
End Sub

‘Get date from file name
Function GetDateFromString(sFilename As String)
Dim sOut As String
sOut = Left(Trim(sFilename), 8)
sOut = Mid(sOut, 5, 2) & "/" & Mid(sOut, 7, 2) & "/" & Left(sOut, 4)
GetDateFromString = sOut
End Function

‘Determine if it’s a weekday (not Sunday or Saturday)
Sub test()
sFiledate = GetDateFromString("20111006 Daily Performance")
MsgBox sFiledate & " -- " & Weekday(sFiledate)
Select Case Weekday(sFiledate)
Case vbSunday, vbSaturday
Case Else
' do the copy of file here
End Select
End Sub
Upvote 0
Thanks xtremegrump & tlowry for your quick response!

But I am little bit confused with your coding. I am not getting in which file I have to paste it.

I have 3 types of files:
1. Where I have to copy the data from( files in a folder names as" 20110102 Daily performance" etc.) - no coding in this file

2. where I have to paste the data ( File on Desktop names "ABC") - no coding in this file

3. file in my personal folder ( having macro for copying the data from the files in above mentioned folder and pasting it in ABC)

Now my coding is in Module 1:

Sub consolidate_data()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ask, ask2, ASK3 As Workbook
Set ASK3 = ActiveWorkbook
Dim i, z1, r, d As Long
Set ask2 = ActiveWorkbook
r = ActiveCell.Row
Workbooks.Open Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
Set ask = ActiveWorkbook

For i = 2 To r
Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
Set ask2 = ActiveWorkbook

Dim mylastrow As Long
Dim mylastcol As Long
On Error Resume Next
mylastrow = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
mylastcol = Cells.Find("*", [a1], , , xlByColumns, xlPrevious).Column
mylastcell = Cells(mylastrow, mylastcol).Address
myrange = "a1:" & mylastcell
z1 = ask.Sheets(1).Range("A65356").End(xlUp).Row + 1
Range("A" & z1).Select
Next i
MsgBox "Done"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

In Module 2:

Sub getfilen()

Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "D:\" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xDirect$ & xFname$
xRow = xRow + 1
xFname$ = Dir
End If
End With

End Sub

Now please tell where I have to put your codings. In the same file or in ABC. Thanks!

Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back