VBA：最後に使用した行に移動しますか？

Question

次のコードを使用して、最初に使用可能な空の行に移動します。これは、最初の空の行リンクに行くような働きをするように設計されています。

コード：

'Go Bottom 
    If Target.Address = "$K$3" Then 
    Range("A8").End(xlDown).Offset(1, 0).Select 
    End If 

コードが最後に使用行を選択するが、ビューにセルをスクロールしません。 ユーザーは引き続きスクロールしなければなりません。

私が間違っている場所を誰かに見せてもらえますか？

全コード：

Option Explicit 
Option Compare Text 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
On Error GoTo Message 
ActiveSheet.DisplayPageBreaks = False 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

    'Go Bottom 
    If Target.Address = "$K$3" Then 
    Range("A8").End(xlDown).Offset(1, 0).Select 
    End If 


    'Clear Search Box 
    If Target.Address = "$L$3:$M$3" Then 

    On Error Resume Next 
    Target.Cells.Interior.Pattern = xlNone 
    Target.Cells.Value = "" 
    SendKeys "{F2}" 

    Else 
    If Target.Address <> "$L$3:$M$3" Then 
    Range("L3").Value = "Search Supplier Name, Number" 
    End If 
    End If 





Message: 
Application.DisplayAlerts = False 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

Exit Sub 

End Sub 


Private Sub Worksheet_Change(ByVal Target As Range) 
On Error GoTo Message 
On Error Resume Next 

ActiveSheet.DisplayPageBreaks = False 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 

'Insert Depot Memo Data for user 
Dim oCell As Range, targetCell As Range 
    Dim ws2 As Worksheet 
    On Error GoTo Message 
    If Not Intersect(Target, Range("B:B")) Is Nothing Then ' <-- run this code only if a value in column B has changed 
     If Not GetWb("Depot Memo", ws2) Then Exit Sub 

     With ws2 
      For Each targetCell In Target 
       Set oCell = .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)).Find(What:=targetCell.Value, LookIn:=xlValues, LookAt:=xlWhole) 
       If Not oCell Is Nothing Then 
        Application.EnableEvents = False 



        'Set Format of cell 
        targetCell.ClearFormats 
        targetCell.Font.Name = "Arial" 
        targetCell.Font.Size = "10" 
        targetCell.Font.Color = RGB(128, 128, 128) 
        targetCell.HorizontalAlignment = xlCenter 
        targetCell.VerticalAlignment = xlCenter 
        targetCell.Borders(xlEdgeBottom).LineStyle = xlContinuous 
        targetCell.Borders(xlEdgeTop).LineStyle = xlContinuous 
        targetCell.Borders.Color = RGB(166, 166, 166) 
        targetCell.Borders.Weight = xlThin 



        targetCell.Offset(0, -1).Value = Now() 
        targetCell.Offset(0, 1).Value = oCell.Offset(0, 1) 
        targetCell.Offset(0, 2).Value = oCell.Offset(0, -2) 
        targetCell.Offset(0, 3).Value = oCell.Offset(0, -7) 

        Application.EnableEvents = True 
       End If 
      Next 
     End With 
    End If 




Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.EnableEvents = True 



'Prompt missed on sale 
    If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value = "Issue Complete" Then 
    If Target.Cells.Count < 8 Then 
    Dim MSG1 As Variant 

    MSG1 = MsgBox("Did Item Miss On-Sale?", vbYesNo, "Feedback") 
    If MSG1 = vbYes Then 
    Range("O" & ActiveCell.Row).Value = "Yes" 
    Else 
    Range("O" & ActiveCell.Row).Value = "No" 
    End If 

    Range("P" & ActiveCell.Row).Value = DateDiff("d", CDate(Format(Range("A" & ActiveCell.Row).Value, "dd/mm/yyyy;@")), Date) 


    End If 
    End If 



If Not Intersect(Target, Range("D" & ActiveCell.Row)) Is Nothing And Target.Value <> "" Then 
Call PhoneBook2 
End If 






'Send Email - Receipt of Issue 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 
If Not Intersect(Target, Range("F:F")) Is Nothing Then 
If Target.Cells.Count < 8 Then 
If Target.Cells.Offset(0, 8).Value = "" Then 

Call SendEmail0 


End If 
End If 
End If 



'Send Email - Status Change 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 
If Not Intersect(Target, Range("N:N")) Is Nothing Then 
If Target.Cells.Count < 8 Then 
If Target.Cells.Offset(0, 8).Value = "" Then 

Call SendEmail 


End If 
End If 
End If 


Application.EnableEvents = True 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 











Message: 
Application.DisplayAlerts = False 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Exit Sub 

End Sub 

おかげ

Answer 1

はこれを試してみてください望むように...

Application.Goto Range("A8").End(xlDown).Offset(1, 0) , True 

Answer 2

あなたはこのようにしてみてくださいました：

If Target.Address = "$K$3" Then 
Range("A8").End(xlDown).Offset(1, 0).Activate 
End If 

あなたはまた、最後の行を検索し、この

のような1つの以上の行を行くことができます

Dim lastRowSheetSix As Long 
lastRowSheetSix = ThisWorkbook.Worksheets("PrepareEmailTL-RRD").Range("C1").SpecialCells(xlCellTypeLastCell).Row 
lastRowSheetSix=lastRowSheetSix+1 

l astRowSheetSix.Selectまたは（アクティブ）あなたは