Hi All,
Thanks to Ron De Bruin, I got below code from one of his sample ADO Tester.
This VBA extract data only from the sheet name "Sheet1" & the range A1:C1, where as I have 10 different sheets with different names and which are updated daily, how can I extract data from all the 10 sheets with their sheet name in first column and their last row data of Row B,C,D,E,F & AJ.
[VBA]Sub GetData_Example6()
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 = "C:\Test" ' <<<< 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 & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
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 = Format(Now, "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
GetData MyPath & MyFiles(Fnum), "Sheet1", "A1:C1", destrange, False, False
Next
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
[/VBA]