• ベストアンサー

【エクセル】元データシートよりマクロで表を複数作成

はじめまして。 ワインの情報が入った元データシートよりマクロを使って それぞれ違うシートに表を複数作成したいのですが、 上手くいきません。 教えていただけますでしょうか。 元データには ワイン名、ヴィンテージ、産地、ブドウ品種の情報があります。 そこから各ワインごとの表を別シートに一度に作成したいです。 添付画像をご参照ください。 ご教授いただけますと幸いです。 よろしくお願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
  • HohoPapa
  • ベストアンサー率65% (455/693)
回答No.1

以下は、 作成したいひな形シートが"ひな形"として作成されている前提です。 Sub kkk()  Dim RowCnt As Long  Dim wsM As Worksheet  Dim wsS As Worksheet    Set wsM = ThisWorkbook.Sheets("元データ")    RowCnt = 2  Do   If wsM.Cells(RowCnt, 1).Value = "" Then Exit Do   Sheets("ひな形").Copy After:=Sheets(ThisWorkbook.Sheets.Count)   ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Format(RowCnt - 1, "0")   Set wsS = ThisWorkbook.Sheets(Format(RowCnt - 1, "0"))   wsS.Cells(1, 2).Value = wsM.Cells(RowCnt, 2).Value   wsS.Cells(2, 2).Value = wsM.Cells(RowCnt, 3).Value   wsS.Cells(3, 2).Value = wsM.Cells(RowCnt, 4).Value   wsS.Cells(4, 2).Value = wsM.Cells(RowCnt, 5).Value   RowCnt = RowCnt + 1  Loop End Sub

sachiko555
質問者

お礼

ありがとうございます。 まさにやりたいことができました! とても助かりました。

その他の回答 (1)

  • kkkkkm
  • ベストアンサー率66% (1734/2604)
回答No.2

新しいシートの書式は変更していません。 新しいシート名はワイン名にします。 既にワイン名のシートがある場合そのデータはとばして次の行に移ります。 Sub Example() Dim ws As Worksheet, Ws1 As Worksheet, NewWs As Worksheet Dim i As Long, flag As Boolean Set Ws1 = Sheets("元データ") With Ws1 For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row flag = False For Each ws In Worksheets If ws.Name = .Cells(i, "A").Value Then flag = True Exit For End If Next ws If flag = True Then MsgBox "既に " & .Cells(i, "A").Value & " 名のシートがあります。", vbInformation Else Set NewWs = Worksheets.Add(after:=Worksheets(Worksheets.Count)) NewWs.Name = .Cells(i, "A").Value NewWs.Range("A1").Resize(4, 1) = _ WorksheetFunction.Transpose(Array(.Range("A1").Value, .Range("B1").Value, .Range("C1").Value, .Range("D1").Value)) NewWs.Range("B1").Resize(4, 1) = _ WorksheetFunction.Transpose(Array(.Cells(i, "A").Value, .Cells(i, "B").Value, .Cells(i, "C").Value, .Cells(i, "D").Value)) End If Set NewWs = Nothing Next End With Set Ws1 = Nothing End Sub

sachiko555
質問者

お礼

ありがとうございます。 参考になりました! とても助かります。

関連するQ&A

専門家に質問してみよう