エクセル2007 VBAについて教えてください。
顧客情報と販売履歴をソフトからCSVで書き出してシート1とシート2へ貼り付けしてそのデータをシート3へ抽出しているのですが、もっと良い方法があれば教えてください。
顧客情報と販売履歴がソフト上の関係で別々に書き出しされる為、シート1へ顧客情報のみを貼り付けしております。シート2に販売履歴を貼り付けしております。
そのデータを別シート
A納品番号 B代引金額 C略称 D客先名 E郵便番号 F住所1 G住所2 H.TEL
K納品番号(A列と同じコードです)L伝票No M管理番号 N客先情報 O商品コードP商品名Q数量 R納入単価 S納入金額 T客先コード変換 U商品名半角
へ転記するようにしております。
ここで抽出ボタン(マクロ起動)すると161行目から抽出するようにしております。
Private Sub CommandButton3_Click()
Range("K161").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A161:A162"), CopyToRange:=Range("K161"), Unique:=False
ActiveWindow.SmallScroll Down:=9
Range("K167").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A167:A168"), CopyToRange:=Range("K167"), Unique:=False
ActiveWindow.SmallScroll Down:=9
Range("K173").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A173:A174"), CopyToRange:=Range("K173"), Unique:=False
ActiveWindow.SmallScroll Down:=6
Range("K179").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A179:A180"), CopyToRange:=Range("K179"), Unique:=False
ActiveWindow.SmallScroll Down:=9
Range("K185").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A185:A186"), CopyToRange:=Range("K185"), Unique:=False
Range("K191").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A191:A192"), CopyToRange:=Range("K191"), Unique:=False
ActiveWindow.SmallScroll Down:=6
Range("K197").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A197:A198"), CopyToRange:=Range("K197"), Unique:=False
ActiveWindow.SmallScroll Down:=6
Range("K203").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A203:A204"), CopyToRange:=Range("K203"), Unique:=False
Range("K210").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A210:A211"), CopyToRange:=Range("K210"), Unique:=False
ActiveWindow.SmallScroll Down:=9
Range("K216").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A216:A217"), CopyToRange:=Range("K216"), Unique:=False
Range("K222").Select
Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"A222:A223"), CopyToRange:=Range("K222"), Unique:=False
そしてこのデータを転送用と言うシート
A3納品番号 B3商品名1 C3商品名2 D3商品名3 E3氏名 F3郵便番号 G3住所1 H3住所2 I3住所3 J3名前2 K3電話番号 R3代引き金額
へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか?
問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。
皆様の知恵をお貸しください。