Option Explicit Sub generateProductSpecDescription() Dim i As Integer Dim productName As String Dim modelName As String Dim spec As String Dim width As Long Dim depth As Long Dim height As Long Dim weight As Double Dim price As Long '製品はB列から始まるためi=2 i = 2 '製品名が存在する限りループ With Worksheets("Sheet1") Do While .Cells(1, i).Value <> "" productName = .Cells(1, i).Value modelName = .Cells(2, i).Value spec