Neues Blatt erstellen und dann zum letzten aktiven Blatt zurückkehren

Question

Schnelle Frage!

Ich habe ein Makro, das Application.AciveSheet verwendet, um auf das aktuelle Arbeitsblatt zu verweisen, da es in einem unserer zahlreichen Arbeitsblätter ausgeführt werden soll. Es kopiert Daten von Application.ActiveSheet auf ein anderes Blatt "Labels". Ich möchte tatsächlich die Blattbeschriftungen in dem Makro erstellen und dann zu Application.AciveSheet zurückkehren, damit der Rest des Makros ausgeführt werden kann. Ich kann nicht, weil "Etiketten" das neue aktive Blatt wird.

Hier ist meine aktuelle Skript Referenz

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

fügen Sie diesen Code am Anfang Ihres Codes (1. Zeile nach 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

ein kleines zwicken an die bestehende gute Antwort hinzufügen würde zu prüfen, ob die Etiketten Blatt nicht bereits vorhanden ist (dh Laufstoppcode mehr als einmal)

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]