创build新工作表，然后返回上一个活动工作表

快速的问题！

我有一个使用Application.AciveSheet来引用当前工作表的macros，因为我希望它可以在我们众多的工作表中运行。 它将数据从Application.ActiveSheet复制到另一个表单“Labels”。 我想实际上在macros中创build表单标签，然后返回到Application.AciveSheet，以便其余的macros可以运行。 我不能因为“标签”成为新的活动工作表。

这是我目前的脚本供参考

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

将现有的好的答案添加一个小的调整来检查标签表是否已经存在（即停止代码运行多次）

 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]