Question

如果你们有人可以提供帮助，那么对某人来说非常快速的问题！

我需要一个宏来将Sheet1中的Cell A1和B1中的数据复制到sheet2中A：B底部的最后一个未使用的单元格中，然后在sheet2中的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

从Sheet1复制行并插入Sheet2的底部

1 个答案: