copy paste from one file to several files - vba

I would like to copy some cells from one file to several files. In order to do so,the macro will copy the range and open the several files in order to paste the values. I perform a loop in order to open each of the destination files (the begin of the name of each of the ouput file is the same but the extension differs from file to file : it is based on a range of cells called Name). The concatenation doesn't work well.
Thank you so much for your help!!
Sub update()
Application.ScreenUpdating = False
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim i As Integer
Dim j As Integer
Dim nrow As Integer
Dim ncol As Integer
Dim Pathref As String
Dim Name As String
nrow = Range("names").Rows.Count
ncol = Range("Range").Columns.Count
'this is the path to the different files, the begin is the same but the extension will be added in the loop (the extentsion is based on the value in the range Name
Pathref = Range("Pathref").Value & "[yasmine_nouri]"
For i = 1 To nrow
Name = Range("Names").Cells(i, 1).Value
Set wkbkorigin = ActiveWorkbook
'here i set my destination file, the begin is the same but the extension is based on the value in the range Name : this concatenation doesn't work.
Set wkbkdestination = Workbooks.Open([& Pathref & Name & ".xlsb"])
Set originsheet = wkbkorigin.Worksheets("Completed_DS")
Set destsheet = wkbkdestination.Worksheets("sheet1")
originsheet.Range("D4:Q5").Copy
destsheet.Range("A1").PasteSpecial
wkbkdestination.Close SaveChanges:=True
Next i
End Sub

As follows up from comments, OP should change
Pathref = Range("Pathref").Value & "[yasmine_nouri]"
'...
Set wkbkdestination = Workbooks.Open([& Pathref & Name & ".xlsb"])
to
Pathref = Range("Pathref").Value & "yasmine_nouri"
'...
Set wkbkdestination = Workbooks.Open(Pathref & Name & ".xlsb")

Related

VBA cellextract for multiple xlsx files returning runtime error 9

At work, I receive a large number of PDF forms. Entry into the forms occurs in a table within the PDF. Specific entries in the PDF must be entered into an Excel sheet (referred to as the tracker from now on). It's very tedious to add each entry. This method is also prone to error.
I then determined that I could turn each PDF into a .xlsx file, keeping the table format. With cells to reference, I made a VLOOKUP formula to extract the exact info I needed for the tracker. I simply had to copy/paste the table range from the newly created converted .xlsx into my VLOOKUP extractor .xlsx, and the needed info would populate for me to paste into the tracker.
However, using this method, I would still need to convert multiple PDFs to .xlsx, open them one by one, paste the table into my extractor .xlsx, and then copy and paste the new extracted data into the tracker. So, still not quite efficient. I determined that I needed a macro.
The macro I found should loop through .xlsx files in a specified folder, opening them and searching for indicated cells. As you can see in the below macro, the cells aren't in any one range. I must extract values from specific cells.
Next, it should extract the values from the indicated cells and populate them as instructed in the sheet the macro was ran from.
However, I keep getting 'run-time error 9 subscript out of range' no matter what I do. Debug points to the following line of code as the reason for the error 9: Set OpenWorksheet = OpenWorkbook.Worksheets(SheetName)
I tried replacing SheetName in the offending line with Table1 only to get the same error. Tried Sheet1 but then get a run-time error 13.
I've been searching the net for a few hours, but I can't quite find a case similar to mine. Any help would be appreciated.
Macro is as follows:
Sub ExtractCells()
' local wb vars
Dim wb As Workbook
Dim ws As Worksheet
Dim MySheet As String
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim r4 As Range
Dim r5 As Range
Dim r6 As Range
Dim r7 As Range
Dim r8 As Range
Dim r9 As Range
Dim r10 As Range
Dim r11 As Range
Dim r12 As Range
Dim i As Integer
' opened wb vars
Dim OpenWorkbook As Workbook
Dim OpenWorksheet As Worksheet
Dim SheetName As String
' looping params
Dim Directory As String
Dim FileSpec As String
Dim MyFile As String
' define looping params
Directory = "C:\MultiPD Test\Forms\" 'CHANGE THIS
FileSpec = ".xlsx" 'CHANGE THIS IF NECESSARY
MyFile = Dir(Directory & "*" & FileSpec)
SheetName = "Table1" 'CHANGE THIS
' set local vars
Set wb = ThisWorkbook
MySheet = "Sheet1" 'CHANGE THIS
Set ws = wb.Worksheets(MySheet)
' This is where data will begin to write
Set r1 = ws.Range("A1")
Set r2 = ws.Range("B1")
Set r3 = ws.Range("C1")
Set r4 = ws.Range("D1")
Set r5 = ws.Range("E1")
Set r6 = ws.Range("F1")
Set r7 = ws.Range("G1")
Set r8 = ws.Range("H1")
Set r9 = ws.Range("I1")
Set r10 = ws.Range("J1")
Set r11 = ws.Range("K1")
Set r12 = ws.Range("L1")
i = 0
' If there is one thing you take away from this, it should be the construct below i.e. how to loop through files
Do While MyFile <> ""
Set OpenWorkbook = Application.Workbooks.Open(Filename:="C:\MultiPD Test\Forms\*.xlsx", ReadOnly:=True)
Set OpenWorksheet = OpenWorkbook.Worksheets(SheetName)
' write data down col
With OpenWorksheet
r1.Offset(i, 0).Value = .Range("C4").Value
r2.Offset(i, 0).Value = .Range("C6").Value
r3.Offset(i, 0).Value = .Range("C8").Value
r4.Offset(i, 0).Value = .Range("C10").Value
r5.Offset(i, 0).Value = .Range("C12").Value
r6.Offset(i, 0).Value = .Range("C15").Value
r7.Offset(i, 0).Value = .Range("C16").Value
r8.Offset(i, 0).Value = .Range("C22").Value
r9.Offset(i, 0).Value = .Range("C35").Value
r10.Offset(i, 0).Value = .Range("C36").Value
r11.Offset(i, 0).Value = .Range("C37").Value
r12.Offset(i, 0).Value = .Range("C38").Value
End With
i = i + 1
MyFile = Dir
Loop
End Sub
As mentioned in the comments:
The first line that should throw Run-time error 1004: file "..." could not be found is this:
Application.Workbooks.Open(Filename:="C:\MultiPD Test\Forms\*.xlsx", ReadOnly:=True)
The next issue is that "Table1" is not a valid sheet name (it seems to be a ListObject name)
Once all sheets from the .XLSX files were renamed to Sheet1 your code works
The version bellow uses an array to reduce repetiton:
Option Explicit
Public Sub ExtractCellsFromMultiFiles()
Const SRC_COL = 3
Dim thisWS As Worksheet, wsName As String, srcRows As Variant
Dim foldr As String, srcFile As String, ext As String
srcRows = Array(4, 6, 8, 10, 12, 15, 16, 22, 35, 36, 37, 38)
wsName = "Sheet1" 'Not "Table1", which is probably a ListObject Table name
Set thisWS = ThisWorkbook.Worksheets(wsName)
foldr = "C:\MultiPD Test\Forms\"
ext = ".xlsx"
srcFile = Dir(foldr & "*" & ext)
Dim srcWB As Workbook, srcWS As Worksheet, i As Long, j As Long
i = 1
Application.ScreenUpdating = False
Do While Len(srcFile) > 0
Set srcWB = Workbooks.Open(Filename:=foldr & srcFile, ReadOnly:=True)
Set srcWS = srcWB.Worksheets(wsName)
For j = 1 To UBound(srcRows) + 1
thisWS.Cells(i, j).Value2 = srcWS.Cells(srcRows(j - 1), SRC_COL).Value2
Next
i = i + 1
srcWB.Close False
srcFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Output:
ColA ColB ColC ColD ColE ColF ColG ColH ColI ColJ ColK ColL
----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
S1C4 S1C6 S1C8 S1C10 S1C12 S1C15 S1C16 S1C22 S1C35 S1C36 S1C37 S1C38
S2C4 S2C6 S2C8 S2C10 S2C12 S2C15 S2C16 S2C22 S2C35 S2C36 S2C37 S2C38
S3C4 S3C6 S3C8 S3C10 S3C12 S3C15 S3C16 S3C22 S3C35 S3C36 S3C37 S3C38

Can I use variable as sheetname (VBA)

I am a newcomer to VBA. I am trying to copy selected range from different workbooks and pasted to a target workbook with different sheetname correspondingly to the name of source file.
The code as below:
'open file
Sub RstChk()
Dim StrFileName As String
Dim StrFilePath As String
Dim TimeStr As String
Dim Version As Integer
Dim x As Workbook
Dim y As Workbook
Dim PstTgt As String
'define filename as array
Dim FN(10) As String
FN(1) = "CIO Wholesale"
FN(2) = "RMG"
FN(3) = "DCM"
FN(4) = "DivHeadOth"
FN(5) = "Runoff"
FN(6) = "Other Risk Subs"
FN(7) = "FIC"
FN(8) = "Treasury"
FN(9) = "Cash Equities"
FN(10) = "Global Derivatives"
'define file path
StrFilePath = "V:\RISKMIS\PUBLIC\apps\MORNING\RMU 1.5 Report\Consolidated\"
'define TimeStr
TimeStr = Format(Now() - 1, "mm-dd-yyyy")
Set y = Workbooks.Open("H:\Eform\Report_checking.xls")
'applying filename from array using loop
'----------------------------------------------------------------
For i = 1 To 10
'define changing file name with path & loop
For Version = 65 To 68
StrFileName = (StrFilePath & FN(i) & "_" & TimeStr & "_" & Chr(Version) & ".xls")
Set x = Workbooks.Open(StrFileName)
'-------------------------------------------------
If Chr(Version) = "A" Then
PstTgt = "A3"
ElseIf Chr(Version) = "B" Then
PstTgt = "E3"
ElseIf Chr(Version) = "C" Then
PstTgt = "I3"
Else
PstTgt = "M3"
End If
'copy the column and paste to report checking
y.Worksheets(FN(i)).PstTgt.Copy Destination = x.Sheets("Risk Summary").Range ("AA5:AC118")
Application.CutCopyMode = False
x.Close
Next Version
Next i
End Sub
I get error when I try to copy the range from source file (x) to target file (Y).
Run-time error '13', type mismatch
Just can't figure out what went wrong.
Thanks very much for your help.
Dan
You got this error because your variable PstTgt is a string and not a range "type mismatch"
If you look at the documentation of Range.Copy https://msdn.microsoft.com/en-us/library/office/ff837760.aspx
You have two choices :
Make PstTgt a range and referencing directly to the range in your endif
' Redefine PstTgt as a range
dim PstTgt as Range
' set value of PstTgt
If Chr(Version) = "A" Then
set PstTgt = y.Worksheets(FN(i)).Range("A3")
endif
...
' Copy the range where you want
PstTgt.Copy destination:=x.Sheets("Risk Summary").Range("AA5")
You keep your code like that and just correct your copy by adding Range
y.Worksheets(FN(i)).Range(PstTgt).Copy Destination = x.Sheets("Risk Summary").Range("AA5")

Extract text from column D to txt files and name files based on content of column C

Apologies for a noob question but I've been fiddling around with this code:
https://stackoverflow.com/a/7151963/3672159
and can't seem to get it modified to do the following (very slight modifications of the code above):
Take as input a worksheet that is called "Export Data" (rather than "Sheet1" as in the existing code; the space seems to cause problems)
Automatically create an empty file for each cell of column D, which should have as its content the value of the respective D cell (same as with the "Disclaimer" data in the code above)
Name each file based on the values of the corresponding C cells (so for me it's name=column C, content=column D rather than B and A in the original code).
I've modified the code as follows:
Sub ExportFiles()
Dim sExportFolder, sFN
Dim rStoreId As Range
Dim rAbstract As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object
'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "my file path\txt"
Set oSh = Export Data
Set oFS = CreateObject("Scripting.Filesystemobject")
For Each rStoreId In oSh.UsedRange.Columns("D").Cells
Set rAbstract = rStoreId.Offset(, -1)
'Add .txt to the article name as a file name
sFN = rStoreId.Value & ".txt"
Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
oTxt.Write rAbstract.Value
oTxt.Close
Next
End Sub
The only thing this does (as does the original code) is create one empty unnamed txt file.
Any help is greatly appreciated!
Try this...
Sub ExportFiles()
Dim sExportFolder, sFN
Dim rStoreId As Range
Dim rAbstract As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object
'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "C:\Users\Rich\Desktop"
Set oSh = ThisWorkbook.Sheets("Export Data")
Set oFS = CreateObject("Scripting.Filesystemobject")
For Each rStoreId In oSh.Columns("D").Cells
If IsEmpty(rStoreId.Value) Then
Exit For
End If
Set rAbstract = rStoreId.Offset(, -1)
'Add .txt to the article name as a file name
sFN = rStoreId.Value & ".txt"
Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
oTxt.Write rAbstract.Value
oTxt.Close
Next
End Sub
You need to select the sheet correctly with (Assuming it is within the same workbook as the code)...
Set oSh = ThisWorkbook.Sheets("Export Data")
And I changed how you were iterating through the range...
For Each rStoreId In oSh.Columns("D").Cells
If IsEmpty(rStoreId.Value) Then
Exit For
End If
Next
This just goes through column D's cells until it hits an empty one, I couldn't quite get it working using UsedRange and this (more old skool) method works in my tests.
This works for me. It writes each value in cells in column D to a text file that is named based on the entry in column C and puts all text files in user specified folder:
Sub ExportFiles()
Dim exportFolder As String
Dim fso As FileSystemObject
Dim stream As TextStream
Dim cl As Range
exportFolder = "C:\User\ExportFolder" //Add you folder path here
Set fso = New FileSystemObject
For Each cl In Worksheets("Export Data").UsedRange.Columns("D").Cells
Set stream = fso.CreateTextFile(filepath & "\" & cl.Offset(0, -1).Value & ".txt", 2, True)
stream.Write cl.Value
stream.Close
Next
End Sub

Looping Macro in Excel

I would like to loop through an Excel worksheet and to store the values based on a unique ID in a text file.
I am having trouble with the loop and I have done research on it with no luck and my current nested loop continually overflows. Instead of updating the corresponding cell when the control variable is modified, it continues to store the initial Index value for all 32767 iterations.
Please can someone explain why this is happening, and provide a way of correcting it?.
Sub SortLetr_Code()
'sort columns for Letr_Code files
Dim lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:B" & lr).Sort key1:=Range("B2"), order1:=1
Application.ScreenUpdating = True
'Value of cell for example B1 starts out as X
Dim x As Integer
Dim y As Integer
x = 2
y = 2
'Cell References
Dim rwCounter As Range
Dim rwCorresponding As Range
Dim rwIndexValue As Range
Dim rwIndexEnd As Range
Dim rwIndexStore As Range
'Variables for files that will be created
Dim FilePath As String
Dim Filename As String
Dim Filetype As String
'Variables defined
FilePath = "C:\Users\Home\Desktop\SURLOAD\"
Filetype = ".dat"
'Use Cell method for Loop
rwIndex = Cells(x, "B").Value
Set rwCounter = Range("B" & x)
'Use Range method for string manipulation
Set rwCorresponding = Range("A" & x)
Set rwIndexValue = Range("B" & y)
Set rwIndexStore = Range("B" & x)
Set rwIndexEnd = Range("B:B").End(xlUp)
'Objects for creating the text files
Dim FileCreate As Object
Set FileCreate = CreateObject("Scripting.FileSystemObject")
'Object for updating the file during the loop
Dim FileWrite As Object
For Each rwIndexStore In rwIndexEnd.Cells
'Get Substring of cell value in BX for the file name
Do Until IsEmpty(rwCounter)
Filename = Mid$(rwIndexValue, 7, 5)
Set FileWrite = FileCreate.CreateTextFile(FilePath + Filename + Filetype)
'Create the file
FileWrite.Write (rwCorresponding & vbCrLf)
Do
'Add values to the textfile
x = x + 1
FileWrite.Write (rwCorresponding & vbCrLf)
Loop While rwCounter.Value Like rwIndexValue.Value
'Close this file
FileWrite.Close
y = x
Loop
Next rwIndexStore
End Sub
I don't see a place you are setting rwCounter inside the loop.
It looks like it would stay on range("B2") and x would just continue to increase until it hits an error, either at the limit of integer or long.
add Set rwCounter = Range("B" & x) somewhere inside your loop to increment it
This is the solution.
Sub GURMAIL_File()
'sort columns for Letr_Code files
Dim lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:B" & lr).Sort key1:=Range("B2"), order1:=1
Application.ScreenUpdating = True
'Variables that store cell number
Dim Corresponding As Integer
Dim Index As Integer
Dim Counter As Integer
Corresponding = 2
Index = 2
Counter = 2
'Cell References
Dim rwIndexValue As Range
'Variables for files that will be created
Dim l_objFso As Object
Dim FilePath As String
Dim Total As String
Dim Filename As String
Dim Filetype As String
Dim FolderName As String
'Variables defined
FilePath = "C:\Users\Home\Desktop\SURLOAD\"
'Name of the folder to be created
FolderName = Mid$(ActiveWorkbook.Name, 9, 8) & "\"
'Folder path
Total = FilePath & FolderName
'File Extension
Filetype = ".dat"
'Object that creates the folder
Set l_objFso = CreateObject("Scripting.FileSystemObject")
'Objects for creating the text files
Dim FileCreate As Object
Set FileCreate = CreateObject("Scripting.FileSystemObject")
'Object for updating the file during the loop
Dim FileWrite As Object
'Get Substring of letter code in order to name the file. End this loop once ID field is null.
Do While Len(Range("A" & Corresponding)) > 0
'Create the directory if it does not exist
If Not l_objFso.FolderExists(Total) Then
l_objFso.CreateFolder (Total)
End If
'Refence to cell containing a letter code
Set rwIndexValue = Range("B" & Index)
'Substring of that letter code
Filename = Mid$(rwIndexValue, 7, 5)
'Create the file using the substring and store it in the proper location
Set FileWrite = FileCreate.CreateTextFile(Total + Filename + Filetype, True)
'For each letter code, find the corresponding values. End the loop once the last value for the letter code is stored.
Do While Range("B" & Index) Like Range("B" & Counter)
'Add each line to the text file.
FileWrite.WriteLine (Range("A" & Corresponding))
'Incrementer variables that allow you to exit the loop
'if you have reached the last value of the current letter code.
Corresponding = Corresponding + 1
Counter = Counter + 1
Loop
'Close the file you were writing to
FileWrite.Close
'Make sure that Index value is updated to the next letter code
Index = Counter
'In case Index value needs updating (safeguard to make sure that the new letter code is stored to index value).
Set rwIndexValue = Range("B" & Index)
Loop
End Sub

How to copy data from another workbook (excel)?

I already have a macro that creates sheets and some other stuff. After a sheet has been created do I want to call another macro that copies data from a second excel (its open) to first and active excel file.
First I want to copy to headers, but I cant get that to work - keep getting errors.
Sub CopyData(sheetName as String)
Dim File as String, SheetData as String
File = "my file.xls"
SheetData = "name of sheet where data is"
# Copy headers to sheetName in main file
Workbooks(File).Worksheets(SheetData).Range("A1").Select # fails here: Method Select for class Range failed
Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)
End Sub
What is wrong ?
I really want to avoid having to make "my file.xls" active.
Edit: I had to give it up and copy the SheetData to target file as a new sheet, before it could work.
Find and select multiple rows
Two years later (Found this on Google, so for anyone else)... As has been mentioned above, you don't need to select anything. These three lines:
Workbooks(File).Worksheets(SheetData).Range("A1").Select
Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)
Can be replaced with
Workbooks(File).Worksheets(SheetData).Range(Workbooks(File).Worksheets(SheetData). _
Range("A1"), Workbooks(File).Worksheets(SheetData).Range("A1").End(xlToRight)).Copy _
Destination:=ActiveWorkbook.Sheets(sheetName).Cells(1, 1)
This should get around the select error.
Best practice is to open the source file (with a false visible status if you don't want to be bother) read your data and then we close it.
A working and clean code is avalaible on the link below :
http://vba-useful.blogspot.fr/2013/12/how-do-i-retrieve-data-from-another.html
Would you be happy to make "my file.xls" active if it didn't affect the screen? Turning off screen updating is the way to achieve this, it also has performance improvements (significant if you are doing looping while switching around worksheets / workbooks).
The command to do this is:
Application.ScreenUpdating = False
Don't forget to turn it back to True when your macros is finished.
I don't think you need to select anything at all. I opened two blank workbooks Book1 and Book2, put the value "A" in Range("A1") of Sheet1 in Book2, and submitted the following code in the immediate window -
Workbooks(2).Worksheets(1).Range("A1").Copy Workbooks(1).Worksheets(1).Range("A1")
The Range("A1") in Sheet1 of Book1 now contains "A".
Also, given the fact that in your code you are trying to copy from the ActiveWorkbook to "myfile.xls", the order seems to be reversed as the Copy method should be applied to a range in the ActiveWorkbook, and the destination (argument to the Copy function) should be the appropriate range in "myfile.xls".
I was in need of copying the data from one workbook to another using VBA. The requirement was as mentioned below 1. On pressing an Active X button open the dialogue to select the file from which the data needs to be copied. 2. On clicking OK the value should get copied from a cell / range to currently working workbook.
I did not want to use the open function because it opens the workbook which will be annoying
Below is the code that I wrote in the VBA. Any improvement or new alternative is welcome.
Code: Here I am copying the A1:C4 content from a workbook to the A1:C4 of current workbook
Private Sub CommandButton1_Click()
Dim BackUp As String
Dim cellCollection As New Collection
Dim strSourceSheetName As String
Dim strDestinationSheetName As String
strSourceSheetName = "Sheet1" 'Mention the Source Sheet Name of Source Workbook
strDestinationSheetName = "Sheet2" 'Mention the Destination Sheet Name of Destination Workbook
Set cellCollection = GetCellsFromRange("A1:C4") 'Mention the Range you want to copy data from Source Workbook
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
'.Filters.Add "Macro Enabled Xl", "*.xlsm;", 1
For intWorkBookCount = 1 To .SelectedItems.Count
Dim strWorkBookName As String
strWorkBookName = .SelectedItems(intWorkBookCount)
For cellCount = 1 To cellCollection.Count
On Error GoTo ErrorHandler
BackUp = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount))
Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = GetData(strWorkBookName, strSourceSheetName, cellCollection.Item(cellCount))
Dim strTempValue As String
strTempValue = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)).Value
If (strTempValue = "0") Then
strTempValue = BackUp
End If
Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = strTempValue
ErrorHandler:
If (Err.Number <> 0) Then
Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = BackUp
Exit For
End If
Next cellCount
Next intWorkBookCount
End With
End Sub
Function GetCellsFromRange(RangeInScope As String) As Collection
Dim startCell As String
Dim endCell As String
Dim intStartColumn As Integer
Dim intEndColumn As Integer
Dim intStartRow As Integer
Dim intEndRow As Integer
Dim coll As New Collection
startCell = Left(RangeInScope, InStr(RangeInScope, ":") - 1)
endCell = Right(RangeInScope, Len(RangeInScope) - InStr(RangeInScope, ":"))
intStartColumn = Range(startCell).Column
intEndColumn = Range(endCell).Column
intStartRow = Range(startCell).Row
intEndRow = Range(endCell).Row
For lngColumnCount = intStartColumn To intEndColumn
For lngRowCount = intStartRow To intEndRow
coll.Add (Cells(lngRowCount, lngColumnCount).Address(RowAbsolute:=False, ColumnAbsolute:=False))
Next lngRowCount
Next lngColumnCount
Set GetCellsFromRange = coll
End Function
Function GetData(FileFullPath As String, SheetName As String, CellInScope As String) As String
Dim Path As String
Dim FileName As String
Dim strFinalValue As String
Dim doesSheetExist As Boolean
Path = FileFullPath
Path = StrReverse(Path)
FileName = StrReverse(Left(Path, InStr(Path, "\") - 1))
Path = StrReverse(Right(Path, Len(Path) - InStr(Path, "\") + 1))
strFinalValue = "='" & Path & "[" & FileName & "]" & SheetName & "'!" & CellInScope
GetData = strFinalValue
End Function