Excel 从活动工作表获取计数，而不是从上一个活动工作表获取计数

这段代码应该根据重复项对B列进行排序，并将重复项粘贴到新创建的工作表中。然后我想运行相同的代码来处理活动工作表（Sheet4）并将副本移动到sheet5

lr = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Row

lr正在从上一张（第1张）中获取计数。如何确保lr计数来自新表4，并且它始终从活动表中获取计数

Sub duplicate()
Dim t As Single
t = Timer
Dim d As Object, x&, xcol As String
Dim lc&, lr&, k(), e As Range
Dim oWS1, oWS2 As Worksheet
xcol = "B"
Set wb = ThisWorkbook
sheetname = ActiveSheet.Name
Worksheets(sheetname).Activate

lc = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Column
lr = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Row
ReDim k(1 To lr, 1 To 1)
Set d = CreateObject("scripting.dictionary")
For Each e In Cells(1, xcol).Resize(lr)
    If Not d.exists(e.Value) Then
        d(e.Value) = 1
        k(e.Row, 1) = 1
    End If
Next e
If d.Count = lr Then
    MsgBox "No duplicates"
    Exit Sub
End If

Cells(1, lc + 1).Resize(lr) = k
Range("A1", Cells(lr, lc + 1)).Sort Cells(1, lc + 1), 1
x = Cells(1, lc + 1).End(4).Row
Set tgt = wb.Sheets.Add(After:=Sheets(Sheets.Count))
tgtLastRow = tgt.Cells(Rows.Count, "A").End(xlUp).Row + 1

Cells(x + 1, 1).Resize(lr - x, lc).Copy tgt.Range("A" & tgtLastRow)
Cells(x + 1, 1).Resize(lr - x, lc).Clear
Cells(1, lc + 1).Resize(x).Clear
MsgBox "Code took " & Format(Timer - t, "0.00 secs")
MsgBox lr & " rows" & vbLf & lc & " columns" & vbLf & _
    lr - x & " duplicate rows"
End Sub

---

我想我可能为你找到了一个更简单的方法。如果sheet4是您想要的计数，则只需将代码更改为：

Sheets("Sheet4").Select
sheetname = ActiveSheet.Name

lc = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Column
lr = Cells.Find("*", After:=[a1], searchdirection:=xlPrevious).Row

这将统计activesheet的行数：

With ActiveSheet

Application.StatusBar = "Counting Rows" 'this just lets your user know what is happening
'you don't have to include this

Count1 = Application.CountA(Range("A:A")) 'if row A would give an accurate count

End With

---

有许多方法可以获得计数。如果这不是您想要的，请评论，我将推荐另一个。

设置sheetname=ActiveSheet.Name时，必须选择sheet1