Question

新手提醒。我创建了一个代码，我想要查找工作表，如果找不到，则创建一个代码。如果它存在，我希望它运行另一个例程。

如果没有工作表，VBA会成功创建一个新工作表并粘贴所有数据，但是当再次运行时，它会尝试添加工作表而不是在工作表已存在时进入该工序。

我查看了有关堆栈溢出和其他地方的20多个问题，几乎所有问题都在寻找表格是否存在的布尔值，这不是我想要的，所以希望这不是重复。

我的理由是，当我运行CheckAndAppend并且sub不能。选择NewSht时，它会出错并转到AddSht并完成。

我第二次运行它时，工作表存在，所以它应该只执行CheckAndAppend而不去AddSht，我认为我可以通过放置＆＃34;退出子＆＃34;来实现。这种情况没有发生。

我的代码如下

Sub CheckAndAppend()
Dim wbCtrl As Workbook
Dim sCurrPeriod As String
Dim Lastrw As Long
Dim NewSht As Variant

Set wbCtrl = Workbooks("Transactions_Convert.xlsm")
sCurrPeriod = wbCtrl.Worksheets("Control").Range("Period")
NewSht = "UK" & sCurrPeriod & "loaded"

'Create a new sheet to store the loaded data if doesn't exist

On Error GoTo AddSht
'CheckAndAppend - perform this when the sheet exists (copy data from Duplicates Sheet, find last row on NewSht and append).
    wbCtrl.Activate
    Sheets("UK_Duplicates_Check").Select
    Range("A2:K" & Row.Count).Select
    Selection.Copy
    Sheets(NewSht).Select
    Lastrw = Cells(Rows.Count, 1).End(xlUp).Row
    Cells(LastRow, 1).Offset(1, 0).Select
    Selection.PasteSpecial Local:=True
    Exit Sub

AddSht:
'Add sheet if it doesn't exist
wbCtrl.Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = NewSht
    Sheets("UK_Duplicates_Check").Select
    Columns("A:K").Select
    Selection.Copy
    Sheets(NewSht).Select
    Range("A1").Select
    ActiveSheet.Paste

End Sub

Answer 1

您正在使用错误来决定是否要添加工作表，但任何错误都将触发该事件并添加工作表。最好不要激活或选择工作表，而是直接引用它们，如复制和粘贴

Sheets("UK_Duplicates_Check").Range("A:K").Copy Sheets(NewSht).Range("A1")

试试这个：

Sub CheckAndAppend()
Dim wbCtrl As Workbook
Dim sCurrPeriod As String
Dim Lastrw As Long
Dim NewSht As Variant

Set wbCtrl = Workbooks("Transactions_Convert.xlsm")
sCurrPeriod = wbCtrl.Worksheets("Control").Range("Period")
NewSht = "UK" & sCurrPeriod & "loaded"

itshere = 0
For Each ws In Excel.Worksheets    'check if worksheet exists without giving an error
    If ws.Name = NewSht Then
        itshere = 1
        Exit For
    End If
Next

If itshere = 0 Then
'Add sheet
wbCtrl.Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = NewSht
    Sheets("UK_Duplicates_Check").Select
    Columns("A:K").Select
    Selection.Copy
    Sheets(NewSht).Select
    Range("A1").Select
    ActiveSheet.Paste
Else
'perform this when the sheet exists (copy data from Duplicates Sheet, find last row on NewSht and append).
    wbCtrl.Activate
    Sheets("UK_Duplicates_Check").Select
    Range("A2:K" & Rows.Count).Select
    Selection.Copy
    Sheets(NewSht).Select
    Lastrw = Cells(Rows.Count, 1).End(xlUp).Row
    Cells(LastRw, 1).Offset(1, 0).Select
    Selection.PasteSpecial Local:=True
End If
End Sub

Answer 2

未经测试，请首先尝试使用您的工作簿副本，但要执行您正在寻找的内容

Sub CheckAndAppend()
    Dim wbCtrl As Workbook
    Dim NewSht As Worksheet
    Dim sCurrPeriod As String, NewShtname As String
    Dim Lastrw As Long

    Set wbCtrl = Workbooks("Transactions_Convert.xlsm")
    sCurrPeriod = wbCtrl.Worksheets("Control").Range("Period")
    NewShtname = "UK" & sCurrPeriod & "loaded"
    ' Test if shet exists
    On Error Resume Next
    Set NewSht = wbCtrl.Sheets(NewShtname)
    On Error GoTo 0
    ' If sheet doesn't exist create
    If NewSht Is Nothing Then
        Set NewSht = wbCtrl.Sheets.Add(after:=Sheets(wbCtrl.Count))
        NewSht.Name = NewShtname
    End If
    ' Copy source
    With wbCtrl.Sheet("UK_Duplicates_Check")
        .Range("A2:K" & .Cells(.Rows.Count, 1).End(xlUp).Row).Copy
    End With
    ' Paste to destination
    With NewSht
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial local:=True
    End With
End Sub

Vba如果未找到工作表，则创建/附加数据

2 个答案: