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