D
DavidH56
Hello,
I've had a great deal of success with assistance from several experts on
this site. I thank those experts who provide their much needed assistance to
those like me, somewhat familiar with vba be still in need of much
improvement. I am currently using a reference to A1:K500 in this bit of
fabulous code I've picked up form this site (I believe from Mr. De Bruin) but
what I really what is through the end of the used range or to the last row.
the code is as follows:
Sub GetLastReportsData()
Dim MyPath As String
Dim FilesInPath As String
Dim sh As Worksheet
Dim MyFiles() As String
Dim FNum As Long
Dim rnum As Long
Dim destrange As Range
MyPath = Location & "\Prior Report\" ' <<<< Change
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls*")
If FilesInPath = "" Then
MsgBox "No files found in Prior Report's Folder"
Exit Sub
End If
On Error GoTo CleanUp
Application.ScreenUpdating = False
'Add worksheet to the Activeworkbook and use the Date/Time as name
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = "Olddata"
Columns("E:G").Select
Selection.NumberFormat = "[$-409]dd-mmm-yy"
' 'Fill the array(myFiles)with the list of Excel files in the folder
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop
'Loop through all files in the array(myFiles)
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 = MyPath & MyFiles(Fnum)
'Get the cell values and copy it in the destrange
'Change the Sheet name and range as you like
'Change the Sheet name and range as you like
GetData MyPath & MyFiles(FNum), "EventWS", "A1:K500", destrange,
False, False
Next
End If
'Columns("C:C").Delete
namefixer
Range("D:F,I:I").Select
Selection.NumberFormat = "[$-409]d-mmm-yy;@"
Range("D2").Select
CleanUp:
Application.ScreenUpdating = True
End Sub
Thanks once again in advance for your assistance.
I've had a great deal of success with assistance from several experts on
this site. I thank those experts who provide their much needed assistance to
those like me, somewhat familiar with vba be still in need of much
improvement. I am currently using a reference to A1:K500 in this bit of
fabulous code I've picked up form this site (I believe from Mr. De Bruin) but
what I really what is through the end of the used range or to the last row.
the code is as follows:
Sub GetLastReportsData()
Dim MyPath As String
Dim FilesInPath As String
Dim sh As Worksheet
Dim MyFiles() As String
Dim FNum As Long
Dim rnum As Long
Dim destrange As Range
MyPath = Location & "\Prior Report\" ' <<<< Change
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls*")
If FilesInPath = "" Then
MsgBox "No files found in Prior Report's Folder"
Exit Sub
End If
On Error GoTo CleanUp
Application.ScreenUpdating = False
'Add worksheet to the Activeworkbook and use the Date/Time as name
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = "Olddata"
Columns("E:G").Select
Selection.NumberFormat = "[$-409]dd-mmm-yy"
' 'Fill the array(myFiles)with the list of Excel files in the folder
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop
'Loop through all files in the array(myFiles)
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 = MyPath & MyFiles(Fnum)
'Get the cell values and copy it in the destrange
'Change the Sheet name and range as you like
'Change the Sheet name and range as you like
GetData MyPath & MyFiles(FNum), "EventWS", "A1:K500", destrange,
False, False
Next
End If
'Columns("C:C").Delete
namefixer
Range("D:F,I:I").Select
Selection.NumberFormat = "[$-409]d-mmm-yy;@"
Range("D2").Select
CleanUp:
Application.ScreenUpdating = True
End Sub
Thanks once again in advance for your assistance.