有没有办法在新工作表上打印列中的最后一行？

Question

im trying to find the last row in a column with in each sheet, so if the last column in sheet1 is BD30 then i want that value to be printed on the sheet i created to get the values and input them there.

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim LastColumn As Integer
    
     Set wb = ActiveWorkbook
    Sheets.Add.Name = "Data"
    Dim shtMain As Worksheet
    Set shtMain = wb.Sheets("Data")
    
    Dim LastRow As Integer
    LastRow = shtMain.Range("A1").CurrentRegion.Rows.Count
    
    Dim c As Range

    For Each sht In wb.Worksheets
        If sht.Name <> shtMain.Name Then
            LastColumn = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column
            With shtMain.Range("A1", "A" & LastRow)
                Set c = .Find(sht.Name, LookIn:=xlValues)
                If Not c Is Nothing Then
                    c.Offset(0, 1).Value = LastColumn
                Else
                    With shtMain.Range("A" & LastRow)
                        .Offset(1, 0).Value = sht.Name
                        .Offset(1, 1).Value = LastColumn
                        LastRow = LastRow + 1
                    End With
                End If
            End With
        End If
    Next sht
End Sub

this is the code i have it works, but the problem is that it counts how many rows there are so for example in sheet1 there are 55 rows it will show 55 and thats not what i want, i want to show me the value of the last row in column that contains data.

this is what i get when i run my code. it counts the rows but i want it to paste the last row value not count the rows. so for example if the last row is BB40 then i want that to show.

Answer 1

I think this is what you want.

Sub Test()        

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim SourceRow As Integer
    Dim SourceCol As Integer
    Dim SourceValue As Variant
    Dim LastRow As Integer
    Dim shtMain As Worksheet
    Dim c As Range
    
     Set wb = ActiveWorkbook
    Sheets.Add.Name = "Data"
    Set shtMain = wb.Sheets("Data")
    
    LastRow = shtMain.Range("A1").CurrentRegion.Rows.Count
    

    For Each sht In wb.Worksheets
        If sht.Name <> shtMain.Name Then
            With sht.UsedRange
                SourceRow = .Rows(.Rows.Count).Row
                SourceCol = .Columns(.Columns.Count).Column
                SourceValue = .Cells(SourceRow, SourceCol).Value
            End With
            With shtMain.Range("A1", "A" & LastRow)
                Set c = .Find(sht.Name, LookIn:=xlValues)
                If Not c Is Nothing Then
                    c.Offset(0, 1).Value = LastColumn
                Else
                    With shtMain.Range("A" & LastRow)
                        .Offset(1, 0).Value = sht.Name
                        .Offset(1, 1).Value = SourceValue
                        LastRow = LastRow + 1
                    End With
                End If
            End With
        End If
    Next sht
End Sub

BTW, as a question of style, I would stongly recommend you move all you Dim statements up to the top of the function.

Answer 2

List of Last Cell Values

• It is assumed that the code is in the relevant workbook.
• Adjust the values in the constants section.

Option Explicit

Sub listLastCells()
    
    ' Constants
    Const dName As String = "Data"
    Const dFirst As String = "A2"
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Delete Destination Worksheet (if it exists).
    On Error Resume Next
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    On Error GoTo 0
    If Not dws Is Nothing Then
        Application.DisplayAlerts = False
        dws.Delete
        Application.DisplayAlerts = True
    End If
    
    ' Define Data Array.
    Dim Data As Variant: ReDim Data(1 To wb.Worksheets.Count, 1 To 2)
    
    ' Declare additional variables.
    Dim sws As Worksheet
    Dim sCell As Range
    Dim r As Long
    
    ' Write worksheet data to Data Array.
    For Each sws In wb.Worksheets
        r = r + 1
        Data(r, 1) = sws.Name
        Set sCell = sws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If Not sCell Is Nothing Then
            Set sCell = sws.Cells(sCell.Row, _
                sws.Cells.Find("*", , , , xlByColumns, xlPrevious).Column)
            Data(r, 2) = sCell.Value
        End If
    Next sws
    
    ' Add and rename Destination Worksheet.
    Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    dws.Name = dName
    
    ' Write values from Data Array to Destination Range.
    dws.Range(dFirst).Resize(r, 2).Value = Data

End Sub