reutrn a value from a cell in each workbook filename from anot
nothing happened... i changed the code a bit though, since i was using
"total" instead of "grand total", and "sheet1" i changed to "production
cost", which is my sheet name...
nothing happened, the only comforting difference right now is that i don't
have to bother putting a "\" after the A1 cell for the first macro to run...?
my code now looks like this....
Sub myDIR()
myfolder = Range("A1").Value
RowCount = 2
First = True
Do
If First = True Then
Filename = Dir(myfolder & "\*.xls")
First = False
Else
Filename = Dir()
End If
If Filename < "" Then
Range("A" & RowCount) = Filename
RowCount = RowCount + 1
End If
Loop While Filename < ""
End Sub
Sub Gettotals()
myfolder = Range("A1").Value
With ThisWorkbook.ActiveSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set FileNames = .Range("A2:A" & LastRow)
End With
For Each Cell In FileNames
Workbooks.Open Filename:=myfolder & "\" & Cell
Set sht = ActiveWorkbook.Sheets("Sheet1").Cells
Set c = sht.Find(what:="TOTAL", LookIn:=xlValues)
If Not c Is Nothing Then
total = c.Offset(rowoffset:=0, columnoffset:=1)
Cell.Offset(rowoffset:=0, columnoffset:=1) = total
End If
ActiveWorkbook.Close
Next Cell
End Sub
"Joel" wrote:
I made some minor changes. The code needed "myfolder" to open the workbooks.
Your code only had the filename and not the path. From you code it looks
like in row 1 your have something like c:\temp\test. there is no slash at
the end of the folder name.
Sub myDIR()
myfolder = Range("A1").Value
RowCount = 2
First = True
Do
If First = True Then
Filename = Dir(myfolder & "\*.xls")
First = False
Else
Filename = Dir()
End If
If Filename < "" Then
Range("A" & RowCount) = Filename
RowCount = RowCount + 1
End If
Loop While Filename < ""
End Sub
Sub Gettotals()
myfolder = Range("A1").Value
With ThisWorkbook.ActiveSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set FileNames = .Range("A2:A" & LastRow)
End With
For Each Cell In FileNames
Workbooks.Open Filename:=myfolder & "\" & Cell
Set sht = ActiveWorkbook.Sheets("Sheet1").Cells
Set c = sht.Find(what:="GRAND TOTAL", LookIn:=xlValues)
If Not c Is Nothing Then
total = c.Offset(rowoffset:=0, columnoffset:=1)
Cell.Offset(rowoffset:=0, columnoffset:=1) = total
End If
ActiveWorkbook.Close
Next Cell
End Sub
|