エクセル マクロ

質問

お世話になります
在庫シ－トにＣ８品番　Ｄ８に仕入れ先...Ｍ８に金額とあり
Ｃ９－Ｍ９（以下デ－タ-がある行）までをオ－トフィルタ－で摘出し
もし　Ｃ列が1ならその行すべてを
販売済シ－トのＣ９－Ｍ９（以下デ－タ-がある行）に貼り付けたいのですが

また、保存して次回開いた時、同じ作業をして販売済シ－トの
最終行の1行下からデ－タ-を貼り付けたいのですが

Sub Macro1()
Dim I As Long
With Worksheets("在庫").Range("B8")
Dim mybtn As Integer
Dim mymsg As String, mytitle As String
mymsg = "全ての最終行は行は一致していますか？"
mytitle = "［Ｂ］列から［Ｎ］列の確認"
mybtn = MsgBox(mymsg, vbOKCancel + vbExclamation, mytitle)
If mybtn = vbCancel Then
End If

.AutoFilter Field:=2, Criteria1:="1"
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("販売済").Range("c65536").End(xlUp).Offset(1, 0).Paste

End With
For I = 1 To 4
Worksheets("販売済").Columns(I).ColumnWidth = _
Worksheets("在庫").Columns(I).ColumnWidth
End　Sub

宜しくお願い致します

回答No.1

imogasi · ベストアンサー

質問に沿った回答ではありませんが、
Filterなど使わず、簡単に
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d1 = sh1.Range("A65536").End(xlUp).Row
d2 = sh2.Range("A65536").End(xlUp).Row
k = d2 + 1
For i = 1 To d1
If sh1.Cells(i, "C") = 1 Then
sh1.Range(sh1.Cells(i, "A"), sh1.Cells(i, "M")).Copy sh2.Cells(k, "A")
k = k + 1
End If
Next
End Sub
Ｃ列が１のもの抜き出し、毎回Ｓｈｅｅｔ２に累積、Ａ－Ｍ列までのデータと仮定してます。
総なめ法ですが、どうせ１度は全行読まないと、抜き出しはできませんから。

お礼

imogasi様
いつもお世話になります
ありがとうございます

とりあえず、お礼まで