Last sheet VBA

[franvlc]

Hi,

I have a macro that runs properly and does the following steps:

- Alows you to select the files you want
- Copy tha range "C30:K30" of every sheet called "Factura"
- Merge all the ranges in a new sheet.

I want to change it in order to get the same range ("C30:K30") but from the last sheet of every workbook. I think that is something like "Sheets(Sheets.Count).Select" but I can't integrate it in the correct way.

The macro is this:

Option Explicit
Sub GetData_Examplefactura()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant, N As Long
Dim rnum As Long, destrange As Range
Dim sh As Worksheet


SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'or use "C:\"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
MultiSelect:=True)
If IsArray(FName) Then
' Sort the Array
FName = Array_Sort(FName)


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-yyyy h-mm-ss")


'Loop through all files you select in the GetOpenFilename dialog
For N = LBound(FName) To UBound(FName)


'Find the last row with data
rnum = LastRow(sh)


'create the destination cell address
Set destrange = sh.Cells(rnum + 1, "A")


' For testing Copy the workbook name in Column E
sh.Cells(rnum + 1, "E").Value = FName(N)




'Get the cell values and copy it in the destrange
'Change the Sheet name and range as you like
GetData FName(N), "factura", "C30:K30", destrange, False, False
Next


End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Thank you so much in advance

 

[wigi]

Hello

Please provide the contents of "GetData", since it is very plausible that changing that code is much easier than changing it (only) in the code above.

Can you please use

 tags when you paste code on the forum?
Code tags format the code making it easier to read and hence follow the logic of the code.


You can use [CODE] tags in this way: 


Add the word [color=blue][b][PLAIN][code=rich][/PLAIN][/B][/color] before the first line of code, and
add the word [color=blue][b][PLAIN]

[/PLAIN][/B][/color] after the last line of code.


Or: you could use the "#" icon when changing / composing a message in the Advanced editing screen.


Thanks for your consideration.

 

[franvlc]

Sorry, I didn't read the forum rules. The code is this:

Option Explicit
Sub GetData_Examplefactura()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant, N As Long
Dim rnum As Long, destrange As Range
Dim sh As Worksheet


SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath 'or use "C:\"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
MultiSelect:=True)
If IsArray(FName) Then
' Sort the Array
FName = Array_Sort(FName)


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-yyyy h-mm-ss")


'Loop through all files you select in the GetOpenFilename dialog
For N = LBound(FName) To UBound(FName)


'Find the last row with data
rnum = LastRow(sh)


'create the destination cell address
Set destrange = sh.Cells(rnum + 1, "A")


' For testing Copy the workbook name in Column E
sh.Cells(rnum + 1, "E").Value = FName(N)




'Get the cell values and copy it in the destrange
'Change the Sheet name and range as you like
GetData FName(N), "factura", "C30:K30", destrange, False, False
Next


End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

I would like to change the origin of the range from a sheet called "Factura" by the last sheet in every file (with random names)

Thanks a lot.

 

[wigi]

Please read back the 2nd sentence I wrote in my post above. And post that code.

 

[franvlc]

Sorry again!

Option Explicit




Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long


    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If


    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If


    On Error GoTo SomethingWrong


    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")


    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1


    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then


        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If


    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If


    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub


SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0


End Sub


Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function




Function Array_Sort(ArrayList As Variant) As Variant
    Dim aCnt As Integer, bCnt As Integer
    Dim tempStr As String


    For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
        For bCnt = aCnt + 1 To UBound(ArrayList)
            If ArrayList(aCnt) > ArrayList(bCnt) Then
                tempStr = ArrayList(bCnt)
                ArrayList(bCnt) = ArrayList(aCnt)
                ArrayList(aCnt) = tempStr
            End If
        Next bCnt
    Next aCnt
    Array_Sort = ArrayList
End Function

 

[wigi]

Hello

With the method that you use to get the data, I do not know how to set the connection string to get the name of the last worksheet.
The thing is: you need the connection string to open up the connection to the file. But before opening up the connection to the file,
you need to know the name of the sheet... Circular reasoning.
I did not use this method before so I cannot comment on what code to use to get the name of a / the last worksheet.