質問: Nothing End Sub
回答: 下記にサンプルコードを作りました。 貼り付け先のシートがなかった場合の生成などは端折っています。 コード内のコメントを見ていただければ、やっていることはご理解頂けるかと思います。 質問の回答のポイントとしては、リストの最初の行から最後の行までフラグの列をチェックすることです。 そのためには、何行目が最終行なのかを先に取得しておく必要があります。 あとはループでフラグの1を探しつつ、見つかったら随時コピーするだけです。 (コピーと言っても、Copyメソッドを使わず、=で直接セルに代入させています) ``` Option Explicit Sub ColCopy() Dim noCol As Integer 'Noの列番号 Dim familyNameCol As Integer '姓の列番号 Dim prefecturesCol As Integer '都道府県の列番号 Dim pasteFlagCol As Integer '貼付けフラグの列番号 Dim lastRow As Long 'リストの最終行 Dim copySheet As Worksheet 'コピー元のワークシート Dim pasteRow As Long '貼り付け先の行番号 Dim pasteSheet As Worksheet '貼り付け先のワークシート Dim i As Long 'ループカウンタ 'このサンプルコードでは、Sheet1からSheet2にコピーします。 '実際のファイル構成に応じて編集してください。 Set copySheet = Worksheets("Sheet1") Set pasteSheet = Worksheets("Sheet2") copySheet.Activate '各列名ごとに列番号を取得します。 '将来、列の位置が移動してもコードを書き換えなくて良くなります。 '列名が変わった場合は書き換えることになりますが、その可能性は低いでしょう。 noCol = SearchCol("No") familyNameCol = SearchCol("姓") prefecturesCol = SearchCol("都道府県") pasteFlagCol = SearchCol("貼付けフラグ") 'Noの最終行をリストの最終行としています。 lastRow = Cells(Rows.Count, noCol).End(xlUp).Row 'リストの最終行に行きつくまでフラグの列をチェックします。 '1があったら貼り付け先のA列に姓、B列に都道府県をコピーします。 pasteRow = 1 For i = 2 To lastRow If Cells(i, pasteFlagCol) = 1 Then pasteSheet.Cells(pasteRow, 1) = Cells(i, familyNameCol) pasteSheet.Cells(pasteRow, 2) = Cells(i, prefecturesCol) pasteRow = pasteRow + 1 End If Next End Sub Function SearchCol(colName As String) Dim colNum As Integer colNum = 1 Do While Cells(1, colNum) <> "" If Cells(1, colNum) = colName Then Exit Do End If colNum = colNum + 1 Loop SearchCol = colNum '一致する列名がなかった場合の処理は書いていません。 '必要に応じて記載してください。 End Function ```