Copy filename to inserted row

[Shweta]

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!

Regards,
Shweta

 

[xtremegrump]

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>

 

[tlowry]

' 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
‘---------------------------------------------
‘---------------------------------------------
‘---------------------------------------------

 

[Shweta]

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
Sheets(1).Select
Range("A65356").Select
Selection.End(xlUp).Select
r = ActiveCell.Row
Workbooks.Open Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
Set ask = ActiveWorkbook

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

Dim mylastrow As Long
Dim mylastcol As Long
Range("A1").Select
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
Range(myrange).Select
Selection.Copy
ask.Activate
ask.Sheets(1).Select
z1 = ask.Sheets(1).Range("A65356").End(xlUp).Row + 1
Range("A" & z1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ask2.Activate
ask2.Close
ask.Sheets(1).Activate
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$
Sheets(1).Select
InitialFoldr$ = "D:\" '<<< Startup folder to begin searching from
Range("a2").Select
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
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
Loop
End If
End With


End Sub

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

Regards,
Shweta