Vbaシートが見つからない場合は、データを追加/追加してください。

Question

新規お知らせ。シートを探したいコードを作成し、シートが見つからない場合は作成します。それが存在する場合、私は別のルーチンを実行したい。

VBAは新しいシートを作成し、シートがない場合はすべてのデータを貼り付けることができますが、再度実行すると、シートがすでに存在するときの手順に進むのではなく、シートを追加しようとします。

私はスタックオーバーフローや他の場所で20以上の質問を見て、ほとんどすべてがシートが存在するかどうかのブール値を探します。これは私が望むものではありませんので、これは重複ではありません。

私が推論したのは、CheckAndAppendを実行したときに、SubがNewShtを選択できないということです。エラーが発生し、AddShtに行き、終了します。

これを2回目に実行すると、シートが存在するので、「Exit sub」を入力することで達成できると思った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