EXCEL VBA コピーしたシートへ値をコピペ
選択対象シート数は4つで、シート名は、「101」「102」「103」「104」とします。
シート名「表紙」のA列のセルはA10：101 A11：102 A12：103 A13：104となっており、
使用者はとなりのB10～B14セルに「○」「×」を入力規則から選択します。
また、シート名「表紙」のB6セルには製造番号（例：AM01-130012）を入力しておきます。
「○」となっているシートのみ選択して、下記マクロにてコピーを作成します。
コピーしたシートすべてのB2セルに製造番号を入力します。
ここまではできていて、下記のプログラムを追加したいのですが、うまくいきません。
さらに、○を付けたのと同じ行のD10～L10、D11～L11、D12～L12、D13～L13セルに、
使用者が文字列を入れる場合と入れない場合があります。文字列は左のD列から順に入れます。
文字列があれば、○を付けてコピーした対応するシートの中のH3～P3セルへ貼り付けたいのです。
D10、D11、D12、D13セルが空白のときは何も処理は行わないとします。
たとえば、下記のようにB12セルが○で、D12セルに文字列があれば、
D12～L12セルの値を、コピーで作成したシート103の中のH3～P3セルへ貼り付けたいのです。
B11セルも○ですが、D11セルに文字列がないのでシートのコピーだけ行います。
アドバイスいただけると助かります。
VBA初心者で申し訳ございませんが、よろしくお願いいたします。
＜表紙のシート＞
A B C D E F G H I J K L
5
6 AM01-130012
7
8
9
10 101 ×
11 102 ○
12 103 ○ A1-1 A1-2 A1-3 A1-4 A1-5 A1-6 A1-7 A1-8 A1-9
13 104 ×
＜プログラム＞
Sub TestSample()
If Application.CountIf(Worksheets("表紙").Range("B10:B17"), "*○*") = 0 Then
MsgBox "部品番号が選択されていません。"
Exit Sub
End If
Dim 製造番号 As String
製造番号 = Range("B6").Value
Dim c As Range
Dim flg As Boolean
On Error Resume Next
flg = True
ThisWorkbook.Activate
On Error GoTo ErrOut_
For Each c In Worksheets("表紙").Range("B10:B13")
If c.Value Like "○*" Then
Worksheets(c.Offset(, -1).Text).Select flg
flg = False
End If
Next c
If Not flg Then ActiveWindow.SelectedSheets.Copy
' コピーしたすべてのシートに製造番号を書き込む
For Each 各シート In Worksheets
With 各シート
.Activate
Cells(1, 2) = 製造番号
End With
Next
Exit Sub
ErrOut_:
MsgBox """表紙""シートに記載されたシート名" & c.Offset(, -1).Text & "は存在しません。, vbInformation"
End Sub
