memo0222

Sub kopipe()

Dim lastrow As Long '行数カウント用の変数
lastrow = Worksheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row

Dim i As Long, j As Long, k As Long
k = 2
For i = 1 To lastrow
j = i + 1

If Worksheets("sheet1").Cells(i, 2).Value = "質問" Then
      Worksheets("sheet1").Cells(j, 2).Copy
            Worksheets("sheet2").Cells(k, 6).PasteSpecial Paste:=xlPasteAll
   
    ElseIf Worksheets("sheet1").Cells(i, 2).Value = "#" Then
            Worksheets("sheet1").Cells(j, 2).Copy
            Worksheets("sheet2").Cells(k, 2).PasteSpecial Paste:=xlPasteAll
            Worksheets("sheet1").Cells(j, 3).Copy
            Worksheets("sheet2").Cells(k, 3).PasteSpecial Paste:=xlPasteAll
            Worksheets("sheet1").Cells(j, 4).Copy
            Worksheets("sheet2").Cells(k, 4).PasteSpecial Paste:=xlPasteAll
            Worksheets("sheet1").Cells(j, 5).Copy
            Worksheets("sheet2").Cells(k, 5).PasteSpecial Paste:=xlPasteAll
    
    ElseIf Worksheets("sheet1").Cells(i, 2).Value = "回答" Then
            Worksheets("sheet1").Cells(j, 2).Copy
            Worksheets("sheet2").Cells(k, 7).PasteSpecial Paste:=xlPasteAll
   
         k = k + 1
End If

MsgBox "完了"

End Sub