Question

快速提问！

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

这是我目前的参考资料

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]

创建新工作表，然后返回上一个有效工作表

2 个答案: