VBA如果表未找到/然后创建/追加数据

Question

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

VBA成功地创建了一个新的工作表并粘贴的所有数据，如果没有表，但再次运行时，它尝试添加的不是去程序当纸张已经存在的薄片。

我看着堆栈溢出20+的问题和其他地区，几乎所有的人都找片是否存在，这不是我想要的东西，所以希望这不是一个重复的一个布尔值。

我的理由是，当我运行CheckAndAppend和子不能在。选择NewSht，它的错误并且去AddSht和完成。

我第二次运行此，板材存在，所以应该不用去AddSht，我想我可以通过把“退出子”实现公正执行CheckAndAppend。这没有发生。

我的代码如下

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

未经检验等工作簿的副本，先试试，但不你在找什么

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 

Answer 2

您正在使用的错误决定，如果纸张是要添加或没有，但任何错误都会触发该事件，并添加纸张。 这也是最好不要激活或选择表，而是直接引用他们这样的复制和粘贴

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