Thank you both for your comments. I will post the VBA that I use
(it's not mine, its something I was either given or pointed to years
ago) at the end, but as originally posted am rusty with excel and
wanted to try keep things as simple as possible.
I used the INDIRECT function to avoid the reference back to the
originating sheet and this did work well when I knew the target cell
address.
=INDIRECT("'Purchase Req. form'!$D$4")
In my current scenario as these reports generate an unknown number of
rows I do not have a known cell row address hence the need for trying
to find last row containing data.
Once again I have a formula that does that but when used referes back
to the originating sheet not the one I've inserted it into
=INDIRECT("'Sheet1'!F"&COUNTA(Sheet1!F:F))
turns into
=INDIRECT("'Sheet1'!F"&COUNTA([PrinterDataCapture.xls]Sheet1!F:F))
For my level of understanding I just need to modify the COUNTA section
to be INDIRECT to find the last row cell in my target workbook.
The VBA used to copy sheet with INDIRECT formulas into folder
containing excel workbooks is:
Sub Copy_Sheet_1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "G:\New"
'Add a slash at the end if the user forget
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
basebook.Worksheets("Sheet2").Copy after:= _
mybook.Sheets(mybook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = basebook.Name
On Error GoTo 0
' You can use this if you want to change the formulas to
values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With
mybook.Close True
FNames = Dir()
Loop
CleanUp:
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
VBA to capture data from worksheet just inserted and pulls into single
new worksheet is:
Sub GetData_Example7()
'Copy cells from folder and subfolder(s)
Dim SubFolders As Boolean
Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object
Dim RootPath As String, FileExt As String
Dim MyFiles() As String, Fnum As Long
Dim sh As Worksheet, destrange As Range
Dim rnum As Long
'Loop through all files in the Root folder
'RootPath = "C:\Data"
RootPath = "G:\Cad\WEB FILES\Test files\mv\"
'Loop through the subfolders True or False
SubFolders = True
'Loop through files with this extension
FileExt = ".xls"
'Add a slash at the end if the user forget it
If Right(RootPath, 1) <> "\" Then
RootPath = RootPath & "\"
End If
Set Fso_Obj = CreateObject("Scripting.FileSystemObject")
If Not Fso_Obj.FolderExists(RootPath) Then
MsgBox RootPath & " Not exist"
Exit Sub
End If
Set RootFolder = Fso_Obj.GetFolder(RootPath)
'Fill the array(myFiles)with the list of Excel files in the
folder(s)
Fnum = 0
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = RootPath & file.Name
End If
Next file
'Loop through the files in the Sub Folders if SubFolders = True
If SubFolders Then
For Each SubFolderInRoot In RootFolder.SubFolders
For Each file In SubFolderInRoot.Files
If LCase(Right(file.Name, 4)) = FileExt Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = SubFolderInRoot & "\" & file.Name
End If
Next file
Next SubFolderInRoot
End If
' Now we can loop through the files in the array MyFiles to get
the cell values
'******************************************************************
'Add worksheet to the Activeworkbook and use the Date/Time as name
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = Format(Now, "dd-mm-yy h-mm-ss")
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
'Find the last row with data
rnum = LastRow(sh)
'create the destination cell address
Set destrange = sh.Cells(rnum + 1, "A")
' Copy the workbook name in Column E
sh.Cells(rnum + 1, "E").Value = MyFiles(Fnum)
'Get the cell values and copy it in the destrange
'Change the Sheet name and range as you like
GetData MyFiles(Fnum), "Link", "A3
C3", destrange, False,
False
Next
End If
End Sub
Hope that tells the whole picture and look forward to any response.
Thanks as always for your help
Don
