2016-10-14 7 views
1

私のプロジェクトにはいくつかのコードが含まれていますが、わかりません。私のWithループは動作しません。特定の値ごとにシートを生成する方法

私の目標は、特定のセルから新しいシートを作成することです。B16 =各セルのハウスや他の新しいシートには、PRIVATEという単語が含まれています。

例: ユーザーがボタンをクリックすると: - タイトルで作成した一つの新しいシート= B16の値ちょうど私の最初のシート(名前MyFirstSheet) 後 - 各セルの値のために作成されたいくつかの他のシートは、単語PRIVATE含まれ、直後前のシート

だから、結果はMyFirstSheet, House, Test1PRIVATE, Test2PRIVATEになります....

Sub NewSheetFromTemplate() 
Dim SearchRange As Range, c As Range 
Dim sht As Worksheet 

'New sheet for a specific cell 
Sheets("TEMPLATE").Copy After:=Sheets("MyFirstSheet") 
ActiveSheet.Name = Sheets("MyFirstSheet").Range("B16").Value 

'New sheet for each cell contains PRIVATE 
With ThiwWorkbook 
    Set SearchRange = ActiveSheet.Range("B16:D70") 
    For Each c In SearchRange 
     If Right(c.Value, 2) = "PRIVATE" Then 
     Sheets("TEMPLATE").Copy After:=Sheets("MyFirstSheet") 
     Sheets("MyFirstSheet").Name = c.Value 
     End If 
    Next c 
End With 
End Sub 

問題がある:私の最初のシートがうまく作成されている(私はMyFirstSheet, House,が作成している)が、各セルのない他のシートが 「PRIVATE」が含まExcelはERROR 1004言うと、タイトルテンプレートのシートを作成した(2)

+0

あなたはそれが動作しないと言います。どのようなエラーが出ますか?コードをステップ実行すると、何が起こりますか? –

+0

@Ferfa yr loopの1番目のcicloの後に[code]それぞれのc SearchRange [/ code]シート( "MyFirstSheet")は、名前をc.valueに変更してから新しいシートをコピーするので存在しません?!?!?! – Fabrizio

答えて

2

私は、あなたは、単に行を変更する必要が正しく質問を理解していれば

If Right(c.Value, 2) = "PRIVATE" Then 
012単語の長さは「プライベート」はさらに7つの文字ではなく2であるからだ

If UCase(Right(c.Value, 7)) = "PRIVATE" Then 

から

は、私は民間が異なるキャップで書かれている場合、それはまた、試合を見つけることを保証するためにUCASEを使用しています。

0

@Fabrizioと@Ralphありがとうございました。

私の最終的なコード:

Sub NewSheetFromTemplate() 
Dim SearchRange As Range, c As Range 
Dim sht As Worksheet 

'New sheet for each value contain "PRIVATE" 
With ThiwWorkbook 
    Sheets(1).Select 
    Set SearchRange = ActiveSheet.Range("A2:C70") 
    For Each c In SearchRange 
     If Right(c.Value, 7) = "PRIVATE" Then 
     Sheets("TEMPLATE").Copy After:=ActiveSheet 
     ActiveSheet.Name = c.Value 
     End If 
    Next c 
End With 

'New sheet for a specific cell: A2 
Sheets(1).Select 
Sheets("TEMPLATE").Copy After:=ActiveSheet 
ActiveSheet.Name = Sheets(1).Range("A2").Value 

'Show OK message 
Sheets(1).Select 
MsgBox "OK, all sheets well created. Please fill out next sheet" 

End Sub 
関連する問題