從Sheet1復制行，並在Sheet2的底部插入

Question

如果有人可以幫忙，一個人很快就會提出疑問！

我需要一個宏來將工作表A1和B1中的數據從Sheet1復制到工作表2中A：B底部的最后一個未使用的單元中，然后按工作表2中的A列中的最低編號到最高編號進行排序。

基本上，我有一個主電話列表，而不是讓人們在整個列表上松散並添加一些東西，我寧願他們在Sheet1中寫入新的號碼和名稱，然后將其自動添加到Sheet2的底部，然后在其中再次排序編號順序。

Answer 1

如果Sheet1中的數據從第1行開始，則下面的代碼會將數據復制到當前數據下面的Sheet2中並對其進行排序

Sub TransferOver()
Application.ScreenUpdating = False
    Dim src As Worksheet, trgt As Worksheet
    Set src = Sheets(1): Set trgt = Sheets(2)
    Dim sr As Range, tr As Range, i As Long

    ' 1 is the first row of data
    For i = 1 To src.Range("A" & Rows.Count).End(xlUp).Row
        Set sr = src.Range("A" & i)
        Set tr = trgt.Range("A" & trgt.Range("A" & Rows.Count).End(xlUp).Row + 1)
        tr = sr
        tr.Offset(0, 1) = sr.Offset(0, 1)
        Set tr = Nothing
        Set sr = Nothing
    Next i

    trgt.Activate
    trgt.Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With trgt.Sort
        .SetRange Range("A2:B" & trgt.Range("A" & Rows.Count).End(xlUp).Row)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Application.ScreenUpdating = True
End Sub