VBA, to extract a single data cell

[Gregfox]

HI, I’m looking for a VBA, to extract a single data cell, from several (new one every day) workbooks, and place them into a single workbook, adding to that new workbook every day.
The data cell is called ‘Liquidating Value’ and each workbook to be extracted from is named;
2011-04-18, 2011-04-17, 2011-04-16 etc.
The code I have so far, works on one file, but I’m seeking to extract the data every day without having to specify a new file name.
Thanks in advance!
I have this code so far;
Sub CopyLiquidating Value()
'Copy cells of columns A,E,H from rows containing "Liquidating Value" in
'col E of the active worksheet (source sheet) to columns
'A,B,C of Sheet2 (destination sheet)

On Error Resume Next
Sheets("RawData").Select
ActiveSheet.Name = "RawData"
'Sheets("Liquidating Value").Select
'ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = False

On Error Resume Next
Sheets("Liquidating Value").Delete
Sheets.Add.Name = "Liquidating Value"
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
'Sheets.Add After:=Sheets(Sheets.Count)
'Sheets("Sheet1").Select
'Sheets("Sheet1").Name = "Liquidating Value"
Sheets("RawData").Select

Dim Lr As Long
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Liquidating Value")

Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long
sCount = 0
dRow = 1

For sRow = 1 To Range("D65536").End(xlUp).Row
'use pattern matching to find "Significant" anywhere in cell
If Cells(sRow, "E") Like "*Liquidating Value*" Then
sCount = sCount + 1
dRow = dRow + 1
'copy cols A,E & H
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "B")
Cells(sRow, "H").Copy Destination:=DestSheet.Cells(dRow, "C")
'Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")
End If
Next sRow

MsgBox sCount & " Significant rows copied", vbInformation, "Transfer Done"

Sheets("Liquidating Value").Select
Columns("A:C").EntireColumn.AutoFit
'Dim Lr As Long (see top)
Lr = Cells(Rows.Count, "C").End(xlUp).Row + 1
Cells(Lr, "c").Formula = "=SUM(c1:C" & Lr - 1 & ")"
Columns("C:C").Select
Range("C49").Activate
Selection.Style = "Currency"

End Sub
<o></o>
<o></o>

 

[JamesW]

Hi,

Will this help you?

Workbooks.Open Filename:="C:\My Folder\" & Format(DateSerial(Year(Date), Month(Date), Day(Date)), "YYYY-MM-DD") & ".xls"

Change File Location to wherever your files are held.

 

[Gregfox]

Thanks, but that only opens one file, I'll modify it to open all files, if not opened before.
Thank you.