[[20100614113853]]　『複数シートからデータの抽出をマクロボタンで』（ペコリン）　ページの最後に飛ぶ

『複数シートからデータの抽出をマクロボタンで』（ペコリン）

こちらで勉強させてもらいながら、受注管理ファイルを作っています。

でも独学初心者の限界で、どうしてもわからなくて困ってます。

 １つのファイルに日報１日から３１日までのシート３１枚があります。
 シート名は「１日」～「３１日」です。
　　　Ａ　　Ｂ　　Ｃ　　Ｄ　　Ｅ　　Ｆ　　Ｇ　　　Ｈ　　　　Ｉ　　　　　Ｊ　　　　　Ｋ　　　Ｌ　　　Ｍ

 １
 ２
 ３
 ４
 ５　番号　コード　品名　個数　名前　〒　住所　電話番号　支払い方法　到着希望日　　時間帯　　未　　　済

 Ｉ列の支払い方法は入力規則のリストを使って８項目から選択するようになっています。
 この支払い方法によって、別シートにデータを抽出し転記したいのです。
 抽出用シートはシート名「支払い方法別」で作り、Ａ１に支払い方法、Ａ２に入力規則のリストで選択できるようにしました。
 Ｂ２～Ｎ２まで日報と同じ見出しが作ってあります。
 その下にフォームコントロールのボタンを作って、ボタンを押せば選択したデータが抽出、転記されるようにしたいのです。
 そして、できればＡ列に抽出先のシート名（１日～３１日）を出したいのですが、そんなことは可能でしょうか？？

 ここ１ヶ月、こちらの過去ログを参考に見よう見真似でやってみてるのですが、複数シートどころか１シートからも抽出できません(TДT)
 助けてください!!!!よろしくお願いします。

 色々やりかたはあると思いますが
 シートをループしつつFindメソッドで転記する行を探しながら行う例です。

 他にもフィルタを使ったり、全部コピーしてから該当しないものを消すなんていう方法もあるかと思います。

  Sub ボタン1_Click()
  Dim ws As Worksheet, myR As Range
  Dim myFind As String, myAd As String
  Dim i As Long
  With Worksheets("支払い方法別").Range("A2")
    .CurrentRegion.Offset(1).ClearContents
    If .Value = "" Then
      Exit Sub
    Else
      myFind = .Value
    End If
  End With
  For Each ws In Worksheets
    If ws.Name Like "*日" Then
      With ws.Columns("I")
        On Error Resume Next
        Set myR = .Find(myFind, .Cells(1), xlFormulas, xlWhole, _
                        xlByRows, xlNext, False, False, False)
        On Error GoTo 0
        If Not myR Is Nothing Then
          myAd = myR.Address(External:=True)
          Do
            i = i + 1
            With Worksheets("支払い方法別").Range("A2")
              .Offset(i).Value = ws.Name
              .Offset(i, 1).Resize(, 14).Value = myR.Offset(, -8).Resize(, 14).Value
            End With
            Set myR = .FindNext(myR)
          Loop Until myAd = myR.Address(External:=True)
        End If
      End With
    End If
  Next ws
  End Sub

 （ｍｏｍｏ）

 momo様、ありがとうございます!!!
 返信遅くなりすみません

 早速やってみたのですが…
 「このブックでマクロが使用できないか、またはすべてのマクロが無効になっている可能性があります」
 というメッセージがでます。
 マクロのセキュリティからマクロの設定を「すべてのマクロを有効にする」にしてみたのですが、同じ結果になります。

 恥ずかしながらコード以前の問題でつまずいてしまってるような…

 もう一度ブックを作り直してmomo様のコードを試してみようと考えてます。
 何かいい方法があれば御教授ください。

 （ペコリン）

 ブックを作り直して、やってみました!!

 …やっぱりできませんでした(；Д；)

 今度はエラーはでませんが、抽出用シートのＡ２（抽出条件の部分）が消えてしまいます。
 でもmomo様にヒントをたくさんいただいたので、自分なりに試行錯誤してみます。
 本当にありがとうございました☆

 （ペコリン）

 A2が消える・・・あ、A1にも値があるんでしたね。
 >.CurrentRegion.Offset(1).ClearContents
 を
 .CurrentRegion.Offset(2).ClearContents
                      ~~~
 に変えてみてください。
 （ｍｏｍｏ）

 やってみました!!!
 すごい!!!できましたっ!!!Σ(ﾟ∀ﾟﾉ)ﾉｷｬｰ
 めちゃくちゃウレシイです
 なぜかはわかりませんが（苦笑）

 悩み続けてきたことが一気に解決です
 １日放置してしまったにもかかわらず、返信して解決してくださって本当に本当にありがとうございます。

 （ペコリン）

コメント返信：

[ 一覧(最新更新順) ]

[[20100614113853]] 『複数シートからデータの抽出をマクロボタンで』（ペコリン） ページの最後に飛ぶ

[[20100614113853]]　『複数シートからデータの抽出をマクロボタンで』（ペコリン）　ページの最後に飛ぶ