创建新表，然后返回最后一个活动表

Question

快速问题！

我有一个使用Application的宏。AcivesHeet参考当前工作表，因为我希望它在我们的众多工作表中运行。它将数据从application.activesheet复制到另一个"标签"。我想在宏中创建表标签，然后返回应用程序。AcivesHeet。以便其余的宏可以运行。我不能因为"标签"成为新的活动表。

这是我当前的脚本供参考

Sub LabelCreation()
'uses the active sheet and Z range to 120
lr = Application.ActiveSheet.Range("Z120").End(xlUp).Row
k = 0
For i = 4 To lr
k = k + 1
Application.ActiveSheet.Range("Z" & i).Copy
Sheets("Labels").Range("A" & k).PasteSpecial Paste:=xlPasteFormats
Sheets("Labels").Range("A" & k).PasteSpecial Paste:=xlPasteValues
Sheets("Labels").Range("B" & k).PasteSpecial Paste:=xlPasteFormats
Sheets("Labels").Range("B" & k).PasteSpecial Paste:=xlPasteValues
Sheets("Labels").Range("C" & k).PasteSpecial Paste:=xlPasteFormats
Sheets("Labels").Range("C" & k).PasteSpecial Paste:=xlPasteValues
Sheets("Labels").Range("D" & k).PasteSpecial Paste:=xlPasteFormats
Sheets("Labels").Range("D" & k).PasteSpecial Paste:=xlPasteValues
k = k + 1
Application.ActiveSheet.Range("AA" & i).Copy
Sheets("Labels").Range("A" & k).PasteSpecial Paste:=xlPasteFormats
Sheets("Labels").Range("A" & k).PasteSpecial Paste:=xlPasteValues
Sheets("Labels").Range("B" & k).PasteSpecial Paste:=xlPasteFormats
Sheets("Labels").Range("B" & k).PasteSpecial Paste:=xlPasteValues
Sheets("Labels").Range("C" & k).PasteSpecial Paste:=xlPasteFormats
Sheets("Labels").Range("C" & k).PasteSpecial Paste:=xlPasteValues
Sheets("Labels").Range("D" & k).PasteSpecial Paste:=xlPasteFormats
Sheets("Labels").Range("D" & k).PasteSpecial Paste:=xlPasteValues
Next
End Sub

Answer 1

在您的代码开头添加此代码（sub之后的第一行）

Sub LabelCreation()
    Set aws = ActiveSheet 'aws is current active sheet
    Sheets.Add 'add a new sheet
    ActiveSheet.Name = "Labels" 'name it "labels"
    aws.Activate 'reactivate initial active sheet
    'uses the active sheet and Z range to 120

Answer 2

会在现有的良好答案中添加一个小的调整，以检查 labels 表不存在（即停止代码多次运行）

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = ActiveSheet
Set ws2 = Sheets.Add
On Error Resume Next
Set ws3 = Sheets("labels")
On Error GoTo 0
If ws3 Is Nothing Then
    ws2.Name = "labels"
Else
    MsgBox "sheet name already exists", vbCritical
End If
Application.Goto ws1.[a1]