Excelマクロでデータの検索とコピー、別のシートへの移動をする方法

このQ&Aのポイント
  • Excelマクロを使用して、合計表のB列とJ列に入力された値に応じて、a、b、cのシートにデータをコピーする方法について質問があります。
  • 合計表のB列とJ列に入力された1はaのシート、2はbのシート、3はcのシートにそれぞれコピーする必要があります。
  • 合計表のA列からG列のデータで、aに変更があった場合にその行をコピーしてaのシートに挿入する方法を教えてください。
回答を見る
  • ベストアンサー

マクロで、データの検索と該当データのコピー、別のシートへ移動

えー・・っと。初めて質問するものです。 エクセルの関数だけでは 問題が解決できないので、マクロに挑戦してますが、息詰ってしまいました。 はじめに、合計表のB列とJ列に 1と入力されたらaと記入、2と入力されたらb、3と入力されたらcという風にマクロを作成。 ココまではできたのですが・・・。 このB列とJ列。それぞれ、aのシート、bのシート、cのシートと 入力された時点で それぞれのシートにコピー振分けしたいのですが・・・。うまくいきません。 コピーしたいデータは 合計表のA列からG列のaに変更になってるデータの一行を部分。(合計表は2分割されてる表なので、B列とJ列) わかりづらいですかね?言いたいことが伝わってるといいのですが・・・。 作ってみたのはこんな感じです。 private sub worksheet_change dim as integer for i=2to63 if cells(i,"a").value=1then cells(i,"b")="a" endif next * b,cも j列の場合も同様につくりました。 dim cl as range set cl=range("B:B").find(what:="a",lookat:=xlwhole) if cl=xlwhole then cells("A:G")=sheet2("asheet") sheets("合計表").copy before:=cells("A:G") ここまでで・・わけがわからなくなりパニックになりました。 そもそもできるのか?という謎も生まれ・・・。 よろしく御願いします。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.2

最初に提示されたコードでは、A列の数値によってB列に文字を入力していますが、補足内容を見る限り、B列の値を文字に変換しているように思えます。どちらでしょうか? 振り分けは、「エクセル 振り分け」などと検索してみるといろいろ出てきます。ひとつ参考に挙げておきます。多くは一度だけ振り分けるもののようです。動的に更新するためには、元のデータに削除や改変を行うかどうか、更新のタイミング(1セルごと、1行ごと、シート切り替え時、ファイル保存時、ボタンを押したときなど)を検討する必要があります。 ちなみにありがとうポイントは、問題が解決して締め切るときに良回答を選択すると発生します。

参考URL:
http://oshiete1.goo.ne.jp/qa2668574.html
tomesan001
質問者

お礼

やっと、なんとかできました。 ありがとうございました。 今後とも、色々学んでいこうと思います。

tomesan001
質問者

補足

ぉ!同じ質問があったのですね? 探し方がわからずにいたので、助かります。 参考にしてやってみますね? ありがとうございます。 それと、  >補足内容を見る限り、B列の値を文字に変換しているように思えます。どちらでしょうか? 補足内容のとおり、B列に1と入力されたら 値をaというように変換です。 説明が下手ですみませんでした。 検索のしかたもためになります。 ほんと、ありがとうございます。

その他の回答 (1)

回答No.1

Private Sub Worksheet_Change(ByVal Target As Range) となっていると思いますが、ここでTargetというのがすでにRange型の変数になっており、変更したセルを示します。これを用いた方が楽です。 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Application.Intersect(Range("A2:A63"), Target) Is Nothing Then Exit Sub '変更セルが対象外のときはコードを実行しない Select Case Target.Value Case 1: Target.offset(, 1).Value = "a" Case 2: Target.offset(, 1).Value = "b" Case 3: Target.offset(, 1).Value = "c" End Select End Sub 振り分け操作は具体例を示していただけないと分かりません。特に二分割のあたりが謎です。 ちなみに、関数でもできることはできます。

tomesan001
質問者

お礼

わぁーぃ!今日は回答はこないかなぁ?って思ってたので 早速の回答うれしいです!ありがとうございます。 試してみます。 それと、やっぱり・・具体例をしないとわかりづらいですよね? えー・・っと。   A  B  C  D  E  F  G  H  I  J  K  L  M  N  O 1 k  1  123 456 258 159 214   f  2 259 254 215 653 852 2 g  2                 t  3            3 r  3                 l  2           4 a  2                  v 1           5 h  3                 o 1           6 y  1                 m 2           7 z  1                  d 2           8 u  2                 s 3           9 w 2             q 3           10 z 3               x 1           ↑ ↑ *1のときA             *1のときA *2のときB              *2のときB *3のときC               *3のときC *AからGまでの部分のそれぞれ1行ずつ *IからOの部分のそれぞれ1行ずつ こんな感じなんですがわかりますか? 確認画面でどうしてもずれてしまぅ・・。 わかりますか? H列は 空白で区切りとして使ってます。 よろしくおねがいします。

tomesan001
質問者

補足

ありがとうポイントってなに? いまいち・・使い方がわかってないようです。 これで、解決?と判断されたのでしょうか???? 謎。

関連するQ&A

  • Excel VBA元データから別シートへ振り分け

    元データ(DB)をA列の値で振り分け 別シート(印刷)に転記していく方法について教えてください。 以下のコードで転記は行えましたが1つの値で1つのシートを作成になってしまいます。 どこをどのように変更すればA列の値(一種類に1つのシートにまとめたい)に 1つのシートに転記となるかご教示お願いします。 Sub test01() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("DB") Set sh2 = Worksheets("印刷") d = sh1.Range("A65536").End(xlUp).Row For i = 2 To d sh2.Cells(6, "B") = sh1.Cells(i, "A") sh2.Cells(10, "B") = sh1.Cells(i, "B") sh2.Cells(10, "C") = sh1.Cells(i, "C") sh2.Cells(10, "D") = sh1.Cells(i, "D") sh2.Cells(10, "E") = sh1.Cells(i, "E") sh2.Cells(10, "F") = sh1.Cells(i, "F") sh2.Cells(10, "G") = sh1.Cells(i, "G") sh2.Cells(10, "H") = sh1.Cells(i, "H") sh2.Cells(10, "J") = sh1.Cells(i, "I") 'sh2.Range("a1:J34").PrintOut Next i End Sub よろしくお願いいたします。

  • 【VBA】Ifで他シートから検索しコピーする

    Excel vbaについて教えてください。 自分で作成したコードが、うまく動かず悩んでいます。 ●作りたいもの Sheet3のA列にある数字を検索値とし、 Sheet1のA列を検索し、合致する行のB列~最終列までコピーし、 Sheet3のB列から貼付する。 ※Sheet1にある列数(項目数)は不定です ●作成したマクロ Sub test() Dim sh1 As WorkSheet Dim sh2 As WorkSheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet3") d = sh2.Range("A1").End(xlDown).Row 'Sheet3検索値のA列のデータの最終行 g = sh1.Range("B1").End(xlToRight).Column 'Sheet1の最終列 k = 2 For i = 2 To d    'Sheet3最終行まで If sh1.Cells( i & "A") = sh2.Cells( 1,"A") Then '条件)Sheet1とSheet3のA列が合致 For j = 2 To g                      'Sheet1の最終列まで sh2.Cells( k , j ) = sh1.Cells( i , j ) 'Sheet1のB行から最終列をコピーしSheet3へ貼付 Next j End If Next End Sub いろいろ直していたのですが、Set sh2 = Worksheets("Sheet3")で「インデックスが有効範囲にありません」(同じブック内に同名シートがあるのに?)とエラーが出たり、 また、B行から最終列までコピーする際の範囲指定についてもよくわからず、 もっと他に良い方法が無いものかとお手上げ状態です。 どうぞ宜しくお願いいたします。

  • データをコピーするマクロを教えてください

    過去に同じような質問と回答があり(QNo.322746)その通りにコーディングしてみましたが、うまく出来ません。どこが違うのか教えてください。よろしくお願いします。 下記テストデータ(Sheet1)のBの6月分のデータ(b3~b6)が毎月変わるので、(Sheet2)に、入力後その月分のデータを年次表へコピーしたいのです。 【過去の質問】 excelで同一ブック内にあるSheet(1)の数値をSheet(2)へ値のみコピーしたいのですが。 (1)Sheet(1)で月報を作成 (2)Sheet(2)の年表へ値のみコピー(転写)。 但し、条件として○○月分とsheet(1)で表示しているものを参照し、Sheet(2)年表の○○月分のセル(○○:○○)にその値を転写したいと思っています。 当方、マクロ等よく分かりませんのでよろしくご教示下さい。 【回答】 テストデータ(Sheet1)ABは行・1~6は列 A B 1 月次表 5月分 2 項目名    計数 3 売上高    1230 4 受手数料 35 5 人員数     37 6 人件費     15 (以下略) テストデータ(Sheet2) Sheet2のデータ部分は空白にして、実行して下さい。 年次表 A B C D 1 4月分 5月分 6月分 7月分 (以下略) 2 項目名 計数 計数 計数 計数 3 売上高 1230 1520 4 受手数料 35 45 5 人員数 37 38 6 人件費 15 16 (以下略) 上記は実行結果です。5月、6月でやって見ました。 シートからALTキーを押しながら、ゆっくりF11、I、Mを 押しModele1を挿入。 (コーディング) Sub test01() For i = 2 To 14 If Worksheets("sheet2").Cells(2, i) = Worksheets("sheet1").Cells(1, 3) Then '前行にくっ付ける For j = 3 To 20 Worksheets("sheet2").Cells(j + 1, i) = Worksheets("sheet1").Cells(j, 2) '前行にくっ付ける Next j Exit For End If Next i End Sub iの14は12か月プラス上、下期小計の2列 jの20は項目の最下行の行番号を仮に20とした。

  • データを別bookシートに移す

    a1シート1のデータ1,2(データ1.5行G列~18行G列,~9000個、データ2.25行G列~38行G列,~9000個)をb1シート1,c1シート1に移行したいのですが、 a1シート1のデータ1,2は、9000個と9000個とします。 b1シート1,c1シート1は、16000個前後をできれば最大にしたいと考えています。 このとき移行したいb1シート1(5行G列~18行G列,~16000個)は最終列からでてしまいます。 出てしまう分をc1シート1(5行G列~18行G列,~2000個)に書き移したいと思っています。 分かりやすくと思い9000個と書きましたが、データにより数は、異なっています。 このとき、データ1とデータ2の連結は、空白行なしです。 b1シート,c1シートは、a1シートとは、別bookです。 こんなときのマクロを教えていただければと思い質問しました。 マクロ記録でしましたが、うまくできませんでした。 コードを教えていただけませんか。 よろしくお願いします。 m2010です。  a1シート1 /ABCDEFGHI-------------MHJ 1データ1 2------9000個 3 4 5------○○~~~~~○○ 6------○○~~~~~○○ 7------○○~~~~~○○ . . . 17-----○○~~~~~○○ 18-----○○~~~~~○○ 19 . . 23データ2 24-----9000個 25-----○○~~~~~○○ 26-----○○~~~~~○○ . . . 37-----○○~~~~~○○ 38-----○○~~~~~○○ 39 b1シート1 /ABCDDEFGHI-----------MHJ-------WQP 1データ1,データ2 2-------16000個 3 4 5-------○○~~~~~○○~~~○○ 6-------○○~~~~~○○~~~○○ 7-------○○~~~~~○○~~~○○ . . . 17------○○~~~~~○○~~~○○ 18------○○~~~~~○○~~~○○ 19 データ1,データ2の継ぎ目に空白なし。 マクロの記録では、 Sub Macro1() ' ' Macro1 Macro ' ' Range("G5").Select ActiveSheet.Paste Range("MHJ5").Select ActiveSheet.Paste Range("F4").Select End Sub c1シート1 /ABCDEFGHI~~ 1データ2の残り 2------2000個 3 4 5------○○~~○○ 6------○○~~○○ 7------○○~~○○ . . . 17-----○○~~○○ 18-----○○~~○○ 19 この質問は、難しいのでしょうか。 書き方がわるいのでしょうか。 よろしくお願いします。

  • VBA 検索するSheetの位置の変更

    現在、グループの数だけユーザー名の合計数をSheet2に抽出するという 事をやっているのですが....... コードの方は下記になります Sub Sample3() Dim i As Long, j As Long, k As Long, lastRow As Long, lastCol As Long Dim wS2 As Worksheet, wS3 As Worksheet Set wS2 = Worksheets("Sheet1") Set wS3 = Worksheets("Sheet2") Application.ScreenUpdating = False If wS2.Range("Y1") = "" Then wS2.Range("Y1") = "ダミー" End If With Worksheets("Sheet1") If .Range("A4") = "" Then .Range("A4") = "ダミー" End If lastRow = .Cells(Rows.Count, "B").End(xlUp).Row Range(.Cells(5, "B"), .Cells(lastRow, "B")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★ For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A") .Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A") Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2) For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1 wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("B:B"), _ wS2.Cells(7, (i - 2) * 8 + 3)) If WorksheetFunction.CountIf(wS2.Columns((i - 2) * 8 + 2), wS2.Cells(k, (i - 2) * 8 + 2)) > 1 Then wS2.Cells(k, (i - 2) * 8 + 2).Resize(, 2).Delete shift:=xlUp End If Next k Next i wS2.Range("B1").CurrentRegion.Borders.LineStyle = xlContinuous wS2.Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole .Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole wS3.Cells.Clear .AutoFilterMode = False End With Application.ScreenUpdating = True End Sub このコードで検索をかけるSheet1のセルBの文字をセルCに移動して検索かけたいという事なのですが、下記の用なコードでBをCに変更してみた結果エラーが発生してしまいます。 lastRow = .Cells(Rows.Count, "C").End(xlUp).Row Range(.Cells(5, "C"), .Cells(lastRow, "C")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★ For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A") .Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A") Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2) For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1 wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("C:C"), _ どなたかご教授の方お願い致します。

  • 検索マクロがおかしくなって原因がわかりません

    Sheet1のA列にはあらかじめ通し番号が1から入っていて、B列3行目からデータを入力していき、データ入力がされているまでの範囲で検索条件を満たすデータをSheet2へ表示させるマクロ実行で、いつしか、Sheet1のB列にデータが入っていないあらかじめ入力済みのA列の番号全てが検索結果として表示されるようになり、原因がわかりません。 お助けください。 Sub 未到着() Dim Rng As Range Dim i As Long Dim Deliveries As Variant Dim h As Long, j As Long Dim DataRows As Long Dim Result As String ''未到着書類(Sheet2)のフィールド行(受付番号、氏名)は、5行目に(設定して)ある With Sheet1 'Sheet1 をオープン .Activate i = 6 '6行目から該当リストを表示させる 'ユーザーフォームによるメッセージ表示 UserForm1.Show vbModeless DoEvents Set Rng = Range("B3", .Range("B65536").End(xlUp)) For Each c In Rng ' "通知書", "受領書", "預り証", "保険証書" の4項目を検索 If Application.CountA(c.Offset(, 9).Resize(, 4)) <> 4 Then 'A列から、A列を含めて14列取得し、未到着書類にコピー c.Offset(, -1).Resize(, 14).Copy Sheet2.Cells(i, 1) i = i + 1 End If Next End With 'メッセージ用のユーザーフォームを閉じる UserForm1.Hide '配列式に格納 Deliveries = Array("通知書", "受領書", "預り証", "保険証書") 'Sheet2 をオープン With Sheet2 .Activate DataRows = Range("A2", Range("A65536").End(xlUp)).Rows.Count + 1 For h = 6 To DataRows '6行目から For j = 11 To 14 '10列目~13列目 If .Cells(h, j).Value = "" Then '調べたセルの文字列0の長さだったら、 '配列より、取り出す Result = Result & ";" & Deliveries(j - 11) End If Next j If Result <> "" Then '結果が空でないなら、N列に貼り付け .Cells(h, 14).Offset(, 1).Value = Mid(Result, 2) Result = "" End If Next h End With End Sub

  • I列でHITさせたデータのみ、別のシートにコピーしたい。(マクロ)

    エクセルでのご教授をお願いします。 シート名「データ」のA3からM159までに、データが入力済みです。 ただし、今後、列方向・行方向ともにデータが増える可能性があります。 I列の入力値は、現在、「1・2・3・4」のどれかです。 今後、「5・6」と増えてゆく可能性もありますが、とりあえずそれは後ほど考えます。 やりたいことですが、 I列のデータが「1」だけのものをまず抽出し、 抽出されたデータの、A列・B列・C列・H列・J列・K列・L列のみを、シート名「1」の3行目以降にコピーしたいのです。 同じくI列のデータが「2」だけのものを抽出し、 抽出されたデータの、A列・B列・C列・H列・J列・K列・L列のみを、シート名「2」の3行目以降にコピーしたいのです。 これをI列に入力されるデータそれぞれに(現在は4まで)をマクロで作成したいのです。 そして、私ではどうしても解決できなかったことなのですが、 例えば「1」シートの最終データの次の行に、集計欄として、データが何件あるかを数えたいのです。 その場合、I列のデータがそれぞれのデータごとに何件あるかが分からないために、どの行に集計欄を作成しておけば良いのか、どうやって判断させたら良いのでしょうか。 申し上げていることを理解していただけておりますでしょうか。 もし意味不明な箇所がございましたら、補足で尋ねていただけると助かります。 よろしくお願いいたします。

  • エクセルマクロ シート間の照合_上書き

    マクロ初心者です。(エクセル2003使用) Sheet2の管理番号をSheet1の管理番号と照合し、同じであれば、数量など3項目を上書きするマクロを作ろうとしています。 (Sheet1:日々更新される元データ)全データ数約500件くらい A列   ,B,  C,  D,   ・・・ 1行 管理番号,品名,注文数量,出荷数量,・・・ (Sheet2:上書きさせたいシート)全データ数約80件くらい G列   ,H,  I   J      9行 管理番号,品名,注文数量,出荷数量 ↑シート2にある管理番号をもとに数量などを照合&上書きをしたいのです。 ■シート1も2も行数は日々変動します。 ■シート1で、まれに同じ管理番号が2つ存在することがありますが、取り出したい数量などのデータは、常に1番目に照合する管理番号です。 Sub シート間照合と上書き() Dim i As Integer a = Worksheets("sheet1").Range("a65536").End(xlUp).Row For i = 2 To a If Worksheets("sheet1").Range("A2") = Worksheets("sheet2").Range("G9") Then Worksheets("sheet1").Cells(1, i) = Worksheets("sheet2").Range("G9") Worksheets("sheet1").Cells(2, i) = Worksheets("sheet2").Range("H9") Worksheets("sheet1").Cells(3, i) = Worksheets("sheet2").Range("I9") While Cells(1, i) <> "" i = i + 1 Wend End If Next End Sub ■上記 模索しながらマクロを作ってみたのですが、エラーにはならないのですが(F8)、まったく動きませんでした。 すみませんが、お力をかしてください。 よろしくお願いいたします。

  • マクロ:データの抽出(複数条件)

    エクセルで以下のようなマクロを作成しました。 シート1のG列がシート2のF4と合致する時、シート2のC列にシート1のB列を貼り付けるのですが、条件を増やし 「シート1G列がシート2のF4と一致」かつ「シート1H列がシート2のG5と一致」かつ「シート1I列がシート2のH5と一致」かつ・・・としたいのですが、If Thenをどのように記述したらよろしいでしょうか。(AND関数の機能です) 宜しくお願いいたします。 Sub data01() With Sheets("Sheet1") x = .UsedRange.Cells(.UsedRange.Count).Row For i = 5 To x If .Cells(i, "G").Value = Worksheets("Sheet2").Range("F4").Value Then n = n + 1 Sheets("Sheet2").Cells(n + 5, "C").Value = .Cells(i, "B").Value End If Next End With End Sub

  • エクセル、マクロにて月を指定して別シートに表示はできるのでしょうか?

    エクセル、マクロにて月を指定して別シートに表示はできるのでしょうか? 毎度毎度申し訳ありません。開始日の検索で、5月と打っただけ5月分だけ表示6月とうったら6月が出て来る方法なんてあるのでしょうか?ありましたら、下記のコードをどう直せいいか教えて頂けますでしょうか?宜しくお願い致します。 【作業内容:場所と月を検索、さらに要らない列を消し、別シートに表示】【検索月はC】  A B   C     D     E     F   G   H    I   J    K 部署 No.  開始日  終了日   担当者  設備  刃名 枚数  内容 工数 備考 茨城 1 2010/5/7  2010/5/10  B緒  L型   K  16枚  研削 6.00 東和電気 東京 2 2010/6/7  2010/6/8   B緒  L型   K  16枚  研削 6.83 東和電気 茨城 3 2010/5/18  2010/5/19  B緒  L型   K  16枚  研削 1.50 東和電気 茨城 4 2010/5/16  2010/5/19  B緒  L型   K  16枚  研削 6.83 東和電気 茨城 5 2010/6/10  2010/6/10  B緒  L型   K  16枚  研削 6.83 東和電気 ↓ A  B   C     D    E     F   部署 No.  開始日  担当者  内容   工数 茨城 1 2010/5/7  B緒   研削   6.00 茨城 3 2010/5/16  B緒  掃除   6.83 茨城 4 2010/5/18  B緒  出荷   1.50 【コード】 Sub 検索() Dim R As Long Dim Row2 As Long '●Sheet2書込み行 Sheets("集計表").Range("A5").CurrentRegion.Clear Sheets("集計表").Range("A5:F5").Value = Array("依頼部署", "依頼書No.", "研磨開始日", "担当者", "作業内容", "作業内容", "工数") Row2 = 5 For R = 2 To Sheets("日報").Cells(Rows.Count, "A").End(xlUp).Row If Sheets("日報").Cells(R, "A") = Sheets("集計表").Range("A2") And _ Sheets("日報").Cells(R, "C") >= Sheets("集計表").Range("B2") And _ Sheets("日報").Cells(R, "C") <= Sheets("集計表").Range("C2") Then Row2 = Row2 + 1 Sheets("集計表").Cells(Row2, "A").Value = Sheets("日報").Cells(R, "A").Value Sheets("集計表").Cells(Row2, "B").Value = Sheets("日報").Cells(R, "B").Value Sheets("集計表").Cells(Row2, "C").Value = Sheets("日報").Cells(R, "C").Value Sheets("集計表").Cells(Row2, "D").Value = Sheets("日報").Cells(R, "E").Value Sheets("集計表").Cells(Row2, "E").Value = Sheets("日報").Cells(R, "I").Value Sheets("集計表").Cells(Row2, "F").Value = Sheets("日報").Cells(R, "J").Value End If Next R '●結果の並べ替え If Row2 = 5 Then MsgBox "該当データなし!" Else Sheets("集計表").Range("A5:D" & Row2).Sort _ Key1:=Range("B6"), Order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, SortMethod:=xlPinYin Sheets("集計表").Select End Sub