別ブックにデータを転記したい

Question

送信状況が未の場合に、あらかじめ作っておいたリストと名付けたブックに以下のように転記したいのですがどのようなマクロを組めばよいでしょうか。

よろしくお願いします。

Answer 1

１．IF文を使い「未」のみコピー（先のjinoji様方式です）
２．オートフィルタで「未」のみフィルタリングしコピー後、コピー先のC列を削除

オートフィルタの場合
☆コピー元のワークブック名と各シート名が不明な為、適当な名前に致しました。

Dim Datasheet As Excel.Worksheet
Dim Reportsheet As Excel.Worksheet

Set DataSheet = Workbooks("Data").Worksheets.Item("Data")
Set Reportsheet = Workbooks("リスト").Worksheets.Item("Report")

Datasheet.AutoFilterMode = False

with dataSheet.Cells(1,1)
    .AutoFilter 3, "未"
    .CurrentRegion.Copy Reportsheet.Cells(1,1)
    .Range("C:C").Delete
end with
Datasheet.AutoFilterMode = False

Answer 2

たとえばこんな感じで組むことができると思います。

Sub sample()
    Dim moto As Worksheet
    Set moto = ThisWorkbook.Worksheets(1)
    Dim lastRow
    lastRow = moto.Range("A" & Rows.Count).End(xlUp).Row
    
    Dim saki As Worksheet
    Set saki = Workbooks("リスト.xlsx").Worksheets(1)
    Dim outRow As Long
    outRow = saki.Range("A" & saki.Rows.Count).End(xlUp).Row + 1
        
    Dim i
    For i = 17 To lastRow
        If moto.Range("C" & i).Value = "未" Then
            saki.Range("A" & outRow).Value = moto.Range("A" & i).Value
            saki.Range("B" & outRow).Value = moto.Range("B" & i).Value
            saki.Range("C" & outRow).Value = moto.Range("D" & i).Value
            outRow = outRow + 1
        End If
    Next
End Sub

Comments

[tiyo]

回答していただきありがとうございます。
Set saki = Workbooks("リスト").Worksheets(1)
の部分で「インデックスが有効範囲にありません」と出で
上手くいかないのですが、対処法などありますでしょうか。

[jinoji]

あ、正確には
Set saki = Workbooks("リスト.xlsx").Worksheets(1)
とかになりますね。（修正しました）
なお、その出力先のブックがあらかじめ開いてあることを前提で書いています。
そうでない場合は、たとえば
Set saki = Workbooks.Open("c:\xxxx\xxxx\リスト.xlsx").Worksheets(1)
みたいな感じになると思います。
ブックに複数シートがあり、出力先が１シート目以外だったら、
Worksheets(1)のところを適切なものに変えてください
（Worksheets("出力先シート")のようにシート名で書いてもいいです。）

[tiyo]

事細かに教えていただきありがとうございます！
参考にさせていただきます。