delete

Sub main()'変数宣言Dim activecell_row As IntegerDim activecell_column As IntegerDim loop_count As Integerloop_count = 1Dim i As IntegerDim row_number As Integerrow_number = 5Dim loop_cnt As Integerloop_cnt = 0Dim sheetname As Stringsheetname = "new sheet"'シート追加Worksheets.Add.Name = sheetname'必要な文言を追加Worksheets("new sheet").Range("B1") = "行"Worksheets("new sheet").Range("C1") = "列"Worksheets("new sheet").Range("D1") = "フォルダ(行)"Worksheets("new sheet").Range("E1") = "フォルダ(列)"Worksheets("new sheet").Range("F1") = "フォルダ"Worksheets("new sheet").Range("G1") = "グループ（行）"Worksheets("new sheet").Range("H1") = "グループ（列）"Worksheets("new sheet").Range("I1") = "グループ"Worksheets("new sheet").Range("J1") = "付与内容（行）"Worksheets("new sheet").Range("K1") = "付与内容（列）"Worksheets("new sheet").Range("L1") = "付与内容"'セルをアクティブ化（本来はBE9）Worksheets("FAD").ActivateRange("C3").Activate'繰り返しDo Until ActiveCell.Value = "endend"'空白の場合→右へ1つ移動If ActiveCell.Value = "" ThenActiveCell.Offset(0, 1).Select'end→下へ一つ移動＋左へ列数分移動ElseIf ActiveCell.Value = "end" ThenActiveCell.Offset(1, "-" & row_number).SelectElseactivecell_row = ActiveCell.rowactivecell_column = ActiveCell.columnloop_count = loop_count + 1Worksheets(sheetname).Range("B" & loop_count) = activecell_rowWorksheets(sheetname).Range("C" & loop_count) = activecell_columnActiveCell.Offset(0, 1).Selectloop_cnt = loop_cnt + 1End IfLoop'新しいシートを編集Dim copy As IntegerDim copy2 As IntegerDim copy3 As StringDim copy4 As StringFor i = 2 To loop_cnt + 1Worksheets(sheetname).Activate'コピーと定数copy = Range("b" & i)Range("d" & i).Value = copyRange("j" & i).Value = copyRange("e" & i).Value = 2Range("g" & i).Value = 2copy2 = Range("c" & i)Range("h" & i).Value = copy2Range("k" & i).Value = copy2'他シートからコピーcopy3 = Worksheets("FAD").Cells(copy, 2)Worksheets("new sheet").Range("f" & i) = copy3copy3 = Worksheets("FAD").Cells(2, copy2)Worksheets("new sheet").Range("i" & i) = copy3copy3 = Worksheets("FAD").Cells(copy, copy2)Worksheets("new sheet").Range("l" & i) = copy3NextMsgBox "完了"End Sub