- 締切済み
複数シートでしょう可能なマクロ作成法
マクロ初心者です。お教えください。 マクロを用いてデータ処理を行っています。1月のシートを用いてマクロ作成をすると、プログラムの 途中ですが以下のようになります。 Application.CutCopyMode = False ActiveWorkbook.Worksheets("1月").Sort.SortFields.Clear ActiveWorkbook.Worksheets("1月").Sort.SortFields.Add Key:=Range("R13"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("1月").Sort この1月限定部分を変更して12ヶ月のいずれの月でも使用可能にしたいのですが、 どのように変更すべきかお教えください。 よろしくご教授ください。
- みんなの回答 (1)
- 専門家の回答
みんなの回答
- NotFound404
- ベストアンサー率70% (288/408)
こんな風にしたらいかが? 標準モジュールに記入します。 タブインデントの替りに全角スペースを使用しています。 Sub test() Dim ws As Worksheet Dim i As Integer, wsNo As Variant Dim msg As String For Each ws In ThisWorkbook.Worksheets i = i + 1 msg = msg & i & " " & ws.Name & vbNewLine Next Do While wsNo < 1 Or wsNo > ThisWorkbook.Worksheets.Count wsNo = InputBox(msg, "番号で選んで") If wsNo = "" Then Exit Sub Else wsNo = Val(wsNo) End If Loop Set ws = ThisWorkbook.Sheets(wsNo) MsgBox ws.Cells(1, 1) '確認用に入れてるだけ Application.CutCopyMode = False ws.Sort.SortFields.Clear ws.Sort.SortFields.Add Key:=Range("R13"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'With ws.Sort '質問が尻切れトンボなので以下は割愛 Set ws = Nothing End Sub ※ あなたのレイアウト次第ですが、1月~12月のシート以外にもあったら余計なお世話かも?
補足
NotFound404さん(正しいかな)早々とご回答いただき有り難うございました。舌足らずな質問でご不明な点が多々あったと思います。お許しください。 マクロの要点は以下のものです。(行と列の変換を月ごとで行うもので、マクロのプログラムにシート名が入った状態です。) Sub Macro2() ' ' Macro2 Macro ' ' Range("R10:AD11").Select Selection.Copy Range("R13").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False ActiveWorkbook.Worksheets("1月").Sort.SortFields.Clear ActiveWorkbook.Worksheets("1月").Sort.SortFields.Add Key:=Range("R13"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("1月").Sort .SetRange Range("R13:S25") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub で、ご指示に沿って以下のように修正してみました。 Sub test() Dim ws As Worksheet Dim i As Integer, wsNo As Variant Dim msg As String For Each ws In ThisWorkbook.Worksheets i = i + 1 msg = msg & i & "" & ws.Name & vbNewLine Next Do While wsNo < 1 Or wsNo > ThisWorkbook.Worksheets.Count wsNo = InputBox(msg, "番号で選んで") If wsNo = "" Then Exit Sub Else wsNo = Val(wsNo) End If Loop Set ws = ThisWorkbook.Sheets(wsNo) MsgBox ws.Cells(1, 1) '確認用に入れてるだけ Application.CutCopyMode = False ws.Sort.SortFields.Clear ws.Sort.SortFields.Add Key:=Range("R13"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'With ws.Sort .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply Set ws = Nothing End Sub です。 どうも初心者のためうまく修正できません。 お忙しいこととと思いますが、ご指導のほどよろしくお願いいたします。