マクロでのデータの抽出＆貼り付けについて

質問

代理店ごとに伝票書類を作成するのに、マクロを組んでいます。
シート１のデータをオートフィルタで抽出して、シート２へ貼り付けますがうまくいかないので教えていただきたいです。

代理店は10社ほどあります。
代理店ごとの伝票（シート２以降）へはシート１の必要なデータのみ貼り付けたいです。

【シート１】
Ａ　Ｂ　Ｃ　Ｄ　Ｅ
代理店名　合計　小計　消費税　注文Ｎｏ
代理店Ａ　○○○　・・・　・・・　aaa
代理店Ｂ　×××　・・・　・・・　bbb
代理店Ａ　 ●●●　・・・　・・・　ccc
代理店Ｃ　△△△　・・・　・・・ ddd

【シート2】「代理店Ａ」
注文No　合計
aaa　○○○
ccc　●●●

下記のマクロが間違っているのは重々承知なのですが、一応記載します。
初心者なので必要な情報があれば、追記しますので教えていただければと思います。

★エクセルは2003です
★貼り付けるときに１行目の「注文No」や「合計」の記載は必要なし
★オートフィルタで抽出後、必要な項目のデータのみ、シート２の各指定の列に貼り付けたい

Sub 代理店A()
With Worksheets("シート１").Range("A1")
.AutoFilter Field:=1, Criteria1:="代理店A"
.CurrentRegion.SpecialCells(xlVisible).Copy Worksheets("代理店A").Range("A1")
.AutoFilter
End With
Worksheets("代理店A").Activate
End Sub

回答No.3

tom04 · ベストアンサー

こんばんは！

オートフィルタ　→　コピー＆ペースト　ではなく、For～Nextを使った一例です。

Sub test()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("代理店A")
'↑　Sheet名の「A」部が全角・半角によって違ってきます。、
'実際のデータに合わせてください。

j = ws2.Cells(Rows.Count, 1).End(xlUp).Row
If j > 1 Then
Range(ws2.Cells(2, 1), ws2.Cells(j, 2)).ClearContents
End If
Application.ScreenUpdating = False
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 1) = ws2.Name Then
With ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Value = ws1.Cells(i, 5)
.Offset(, 1) = ws1.Cells(i, 2)
End With
End If
Next i
Application.ScreenUpdating = True
End Sub

※　上記コードはSheet2のSheet名が抽出したい代理店名になっているとしています。
ご希望の方法でなければ読み流してくださいね。m(_ _)m

お礼

結局オートフィルタで完成させたのですが、一部参考させて頂きました。
シート名は代理店名なので、こちらの方法でも作成してみます。
ありがとうございます。

回答No.4

imogasi

シート１の代理店のデータ（１０社とか）はすべてこの作業で使うのでしょう。Ａ、Ｄ、Ｆ社だけとかは、作り他の代理店は作らないということではないでしょう（たとえ３社しか作らない場合ても下記は有効でしょう）
（１）オートフィルタでＡ社データを抽出するのでなく、代理店名列でソートしなさい（ソート方）
（２）そして上の行からデータを読んで行く。
（３）たとえばＡ，Ｄ、Ｆ社のみ処理するなら、Ａ，Ｄ，Ｆ社を選択するための、名前テーブルを作り、それに該当しない代理店は、データを捨てる（何も処理しない。読み飛ばす）用にすればよい。
この方法は、考えやすく、確実で、処理総時間も少なくなるはず。
昔から使われた、オフラインバッチ処理の王道です。
ーー
例データ　これぐらいの、手をかけて例は作ること。質問者が楽をしないで、回答者の回答の苦労も考えること。
Ａ１：Ｅ１０
代理店名 合計 小計 消費税 注文Ｎｏ
代理店Ａ 129 123 6 111
代理店Ｂ 245 234 11 112
代理店Ａ 453 432 21 113
代理店Ｃ 117 112 5 115
代理店Ａ 328 313 15 116
代理店Ｃ 119 114 5 117
代理店Ａ 225 215 10 119
代理店Ｃ 436 416 20 120
代理店Ａ 437 417 20 134
ーー
Ａ＋Ｅ列でソート（私の独断だが、ここはこれで適当かどうかよく考えること）
代理店名 合計 小計 消費税 注文Ｎｏ
代理店Ａ 129 123 6 111
代理店Ａ 453 432 21 113
代理店Ａ 328 313 15 116
代理店Ａ 225 215 10 119
代理店Ａ 437 417 20 134
代理店Ｂ 245 234 11 112
代理店Ｃ 117 112 5 115
代理店Ｃ 119 114 5 117
代理店Ｃ 436 416 20 120
ーーー
コード
Sub test01()
Set sh1 = Worksheets("Sheet1") '元データシート
d = sh1.Range("A65536").End(xlUp).Row '元データシート最終行
MsgBox d
m = "" '1行前の代理店名＝キー
k = 2 '代理店シートの明細の最初行
n = 1 '代理店シートの最初のシート・インデックス
Set shw = Worksheets(n) '代理店ごとシート
'---
For i = 2 To d
If sh1.Cells(i, "A") = m Then
shw.Cells(k, "B") = sh1.Cells(i, "B")
shw.Cells(k, "C") = sh1.Cells(i, "E")
k = k + 1
Else
n = n + 1 '新しいシートのシートインデックス
Set shw = Worksheets(n)
shw.Range("A1") = sh1.Cells(i, "A")
k = 2
shw.Cells(k, "B") = sh1.Cells(i, "B")
shw.Cells(k, "C") = sh1.Cells(i, "E")
k = k + 1
m = sh1.Cells(i, "A")
End If
Next i
End Sub
ーーーー
結果　－は空白セルです（左詰め表示防止用）
Ｓｈｅｅｔ２
代理店Ａ
- 129 111
- 453 113
- 328 116
- 225 119
- 437 134
Ｓｈｅｅｔ３
代理店Ｂ
- 245 112
Ｓｈｅｅｔ４
代理店Ｃ
- 117 115
- 119 117
- 436 120
＝＝＝
注意
２番目のシート以後のシートは代理店の数以上の白紙のシートをあらかじめ作っておいて実行のこと。
質問者の頭が、パンクしないよう、説明を複雑にしないため、自動追加のコードは略している。手動で追加をやって。

お礼

ありがとうございました。参考にさせていただきました。

回答No.2

某HN クロメート(Chromate)（@CoalTar）

直接、張り付けるのではなく、いったん抽出用シートとして貼り付け
それからコピペさせても良いのでは？

お礼

ありがとうございます。シートを増やさずに作成できました！

回答No.1

keithin

＞貼り付けるときに１行目の「注文No」や「合計」の記載は必要なし
この条件がどうしてついているのか不明ですので

Sub macro1()
　Dim a '★
　a = Worksheets("代理店Ａ").Range("A1:B1").Value '★
　With Worksheets("Sheet1")
　　.Range("A:A").AutoFilter field:=1, Criteria1:="代理店Ａ"
　　.Range("E:E").Copy Destination:=Worksheets("代理店Ａ").Range("A1")
　　.Range("B:B").Copy Destination:=Worksheets("代理店Ａ").Range("B1")
　　.AutoFilterMode = False
　End With
　Worksheets("代理店Ａ").Range("A1:B1").Value = a '★
End Sub

★を付けた行は，無くても良いと思えます。

お礼

ある代理店への売り上げがない場合もあるので、うまくいきませんでした。
ありがとうございます。