[[20050414215944]]　『納期管理表－今日までのデータ印刷実行』（あっちゃん）　ページの最後に飛ぶ

『納期管理表－今日までのデータ印刷実行』（あっちゃん）

こんばんは。また、教えて下さい。

今、納期管理表を作っています。

下記の通りA1に項目、A2～D100までデーターが入っています。

　　　　A　　　　　　B　　　　　　 C　　　　　　　D

1　　品　名　　　　業者名　　　型　式　　　　　納期

2　　バナナ　　　　イ会社　　　３本SET　　　　4/15

3　　みかん　　　　ロ会社　　　２個SET　　　　4/13

～～～

100　　りんご　　　ハ会社　　　５個SET 　　　　4/10

毎日、まだ納品されていない品物のリストを作成する為、D列（納期日付）をソートし、数日前～今日までの分を、範囲指定し印刷をしています。

ちなみに、100行のデータの中には、納期日が未入力のものも、ずっと先の日にちのものもあります。

マクロやVBAなどを利用し、ショートカットキーで、この印刷が実行される方法を教えて頂けないでしょうか？

 オートフィルタで空白セルを抽出し印刷を記録して見ては如何でしょう?
(ケン）

申し訳ありません。

説明が悪いようで。

D列の納期日は、受注した時に決まるのです。

たまたま、近日中の日付しかここでは、例としてあげていませんでしたが、1日～半年先までぐらいの納期が入力してあります。

その数、多い時で、500件ぐらいです。

数々あるデータの中で、納期が今日より以前のものだけを印刷したいのです。

宜しく、お願いいたします。

（あっちゃん）

 オートフィルタのオプションで抽出すれば、記録出来ませんか?
（ケン）

申し訳ありません。
オートフィルタのオプションで、

抽出条件

TODAY() 以下

としましたが、ダメでした。

抽出条件

TODAY() と等しい

ともしてみましたが、やはりダメでした。

どのように、設定すればよいのでしょうか？

（あっちゃん）

 あっちゃんさん！おはようございます。
頑張ってますね(^.^)
そんな時は記録するといいですよ。
ちょっと記録すると↓の様になって
Option Explicit
Sub Macro1()
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="<=2005/4/15", Operator:=xlAnd
End Sub
これをちょろっと加工すると
Sub てすと()
Dim Wh1 As Worksheet, Wh2 As Worksheet
Dim MyTbl As Range
Dim MyDate As String
Set Wh1 = Sheets("Sheet1")
Set Wh2 = Sheets("Sheet2")
With Wh1
    Set MyTbl = .Range("A1", .Range("A65536").End(xlUp)).Resize(, 4)
    MyDate = Format(Date, "yyyy/mm/dd")
    .AutoFilterMode = False
    MyTbl.AutoFilter Field:=4, Criteria1:="<=" & MyDate
    With .AutoFilter.Range
        If .Columns(1).SpecialCells(12).Cells.Count > 1 Then
            Wh2.Cells.ClearContents
            .Copy Destination:=Wh2.Range("A1")
'            Wh2.PrintOut
        Else
            MsgBox "ありません"
        End If
    End With
    .AutoFilterMode = False
End With
Set Wh1 = Nothing
Set Wh2 = Nothing
Set MyTbl = Nothing
End Sub
こうなりましたぁv(=∩_∩=)v
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0279.xls
（SoulMan）

 おはようございます。SoulManさんフォロー有難うございます。
＞これをちょろっと加工すると
ちょろっとじゃない気が・・・(^^
記録したのを加工する、大事ですよね。
（ケン）

 特別サービス！！
サンプルをアップしておきました。
右クリックして
対象ファイルを保存してお試しください。
（SoulMan）

こんばんは。SoulManさま、またまたありがとうございます。

[[20040625010324]]-出荷管理表で、教えて頂いたVBAを使って、別部署で新しい納期管理表を作っています。

この表は、以前同様A列でリスト入力した言葉（納品状態が、「未」「済」）と同じシート名「未」「済」の所に、データが移行するというものです。お蔭様で、この部分に関してはデータスタート行が変更しているにもかかわらず、うまく動いてくれています。（感激！）

今回、印刷したい表の対象範囲は、A100（項目）～K500（データ行が増える可能性大）です。
また、L、M列にもデータが入っていますが、印刷はしたくありません。

その表の中（データ数395個）から、「未」シートのみのJ列に入っている日付が、今日より以前のものだけを印刷したいという希望です。

SoulManさまのup0279のファイル、Sheet1の該当するシートをSheet2に転記するという方法ですね。

説明不足で申し訳ありませんでした。以前作っていただいた「未」「済」転記ということを考えますと･･･。

私なりに考えて、VBAを変更しましたが、根本のSheet転記という部分でVBAが止まっている様子？

一瞬ですがオートフィルタの表示が青い▼も希望のJ列にでます。
しかし、印刷プレビューになりません。

　　　A　　　　　　　B　　　　　C　　　　D　　　　　E　　　F　　　　　　　 G　　　　　　H　　　　　I　　　　　　 J　　　　　K

100　納品状態　　業者　　　ﾌﾘｶﾞﾅ　　製番　　機種　オーダー番号　品目コード　品名　　発注日　　　　納期日　　備考

101　　未　　　　　　イ会社　ｲｶﾞｲｼｬ　　A10　　　○△　　　　123　　　A1B1C1　　　みかん　05/03/31　　　05/04/17　　なし

102　　未　　　　　　ロ会社　ﾛｶｲｼｬ　　 A13　　　○×　　　　128　　　A1D1C1　　　バナナ　05/03/31　　　05/09/15　　なし

103　　未　　　　　　ハ会社　ﾊｶｲｼｬ　　 A20　　　×△　　　　125　　　A1B2C1　　　みかん　05/04/11　　　未定　　　　なし

～～～

200　　未　　　　　　イ会社　ｲｶｲｼｬ　　 A15　　　○△　　　　127　　　A1B1C1　　　みかん　05/04/09　　　05/04/16　　なし

Sub 印刷()
'
' 印刷 Macro

' マクロ記録日 : 2005/4/15 ユーザー名 : user
'

Dim Wh1 As Worksheet
Dim MyTbl As Range
Dim MyDate As String
Set Wh1 = Sheets("未")
With Wh1

    Set MyTbl = .Range("A101", .Range("A65536").End(xlUp)).Resize(, 10)
    MyDate = Format(Date, "yy/mm/dd")
    .AutoFilterMode = False
    MyTbl.AutoFilter Field:=10, Criteria1:="<=" & MyDate
    With .AutoFilter.Range
        If .Columns(1).SpecialCells(12).Cells.Count > 1 Then
        Else
            MsgBox "ありません"
        End If
    End With
    .AutoFilterMode = False
End With
Set Wh1 = Nothing
Set MyTbl = Nothing
End Sub

また、表の一部に関数が使ってある所がある為、シートの保護がかけたいのです。
最初と最後に保護、保護解除を入れたのですが、止まってしまいます。
どうも転記をする時にひっかかるようです。
どこに、入れたらよいのでしょうか？

 Private Sub Worksheet_Change(ByVal Target As Range)
 ActiveSheet.Unprotect　←▲
 Sheets("済").Select　　←▲「済」シートには"未"と。
  ActiveSheet.Unprotect　←▲　
    Sheets("未").Select　←▲「済」シートには"未"と。
 Dim tennki_saki As String
 Dim Wks As Worksheet
 Dim MyRow As Long
 Dim C As Integer, i As Integer
 'シートを保護するのは↓のコードでいいと思います。
 Me.Protect , , , , , True
 'ユーザーの操作のみを保護するものですから、マクロの操作は保護されません。
 'ターゲットの列がA列以外か行が101行より小さかったら無効
 If Target.Column <> 1 Or Target.Row < 101 Then Exit Sub
 'ターゲットの複数選択を不可にする。
 If Target.Count > 1 Then Exit Sub
 'ターゲットのDeleteを無効
 If Target.Value = "" Then Exit Sub
 '転記先はターゲットの値
 tennki_saki = Target.Value
 '転記先が自分だったら無効
 If Me.Name = tennki_saki Then Exit Sub
 'イベントを無効にする。
 Application.EnableEvents = False
 'ワークシートをループ
    For Each Wks In Worksheets
    '変数ｉを初期化
    i = 0
        '転記先のシート名とターゲットの値が同じだったら（つまり、転記先のシートがあったら）
        If Wks.Name = tennki_saki Then
            '転記先シートのB列を基準に最終行+1を取得
            MyRow = Sheets(tennki_saki).Range("B65536").End(xlUp).Row + 1
                With Me  '変数Cを列数分ループ
                    For C = 1 To .Range("A6").End(xlToRight).Column
                        Sheets(tennki_saki).Cells(MyRow, C).Value = Cells(Target.Row, C).Value
                    Next C
                        '転記が完了したら、ターゲットを削除
                        Target.EntireRow.Delete Shift:=xlUp　　　←◎
                End With
            '転記が完了したらループから抜ける
            Exit For
        End If
        '変数iに1を代入してシートの有無を確認
        i = 1
    Next
    '変数iが0じゃなかったら
    If i <> 0 Then
        MsgBox "転記先のシート　「" & tennki_saki & "」　は、ありません。" & Chr(13) & _
                "転記先のシート名が正しいかもう一度確認して下さい。", vbCritical, "Excelの学校　VBA"
    End If
    '移行した行分を補う。
    Rows("498:498").Select
    Selection.Copy
    Rows("497:497").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Range("A101").Select
 'イベントを有効にする。
 Application.EnableEvents = True
 '保護をかける。
 Sheets("済").Select　　←▲「済」シートには"未"と。
 ActiveSheet.Protect　←▲　
    Sheets("未").Select　←▲「済」シートには"未"と。
 ActiveSheet.Protect　←▲　
 Application.ScreenUpdating = True
 End Sub

 こんばんは！遅くなってすみません。
ところで今回はコードの中に説明を書いていますから
説明ごと標準モジュールに貼り付けてください。
Option Explicit
'基本はマクロの記録です。
'それからブレークポイントを覚えた方がいいです。
'簡単に説明しますから、これを機に覚えてください。
Sub Macro1()
'←この灰色のところをマウスでクリックしてください。
Selection.AutoFilter Field:=10, Criteria1:="<=2004/12/20", Operator:=xlAnd
'クリック出来るところと出来ないところがありますが●が付いたらOKです。
'マクロを実行すると●の行でマクロが停止します。これがブレイクポイントです。
'後はF8でひとつひとつステップ実行するんです。
'その時VBE画面を最大表示にしないで小さく表示して実際の動きを確認しながら実行するのが
'ポイントです。ExcelのシートとVBE画面を二つ表示しながら実行するんです。
'ExcelのシートはVBE画面の左上のExcelのマークをクリックすれば表示されます。
End Sub
Sub 印刷()
Dim Wh1 As Worksheet
Dim MyTbl As Range
Dim MyDate As String
Set Wh1 = Sheets("未")
'*********************************************
'抽出する日付を設定します。
MyDate = Format(Date, "yyyy/mm/dd")
'↓日付はこんな書き方も出来ると思います。例は今日の一日前です。
'MyDate = Format(DateSerial(Year(Date), Month(Date), Day(Date) - 1), "yyyy/mm/dd")
'**********************************************
With Wh1
    Set MyTbl = .Range("A101", .Range("A65536").End(xlUp)).Resize(, 10)
    '****************************************************
    '印刷に関する設定をします。
    '実際の設定を記録して応用されたらいいでしょう。
    With .PageSetup
        .PrintArea = MyTbl.Address
        .PrintTitleRows = "$101:$101"
    End With
    '******************************************************
    'オートフィルタを一旦解除します。
    .AutoFilterMode = False
    'オートフィルタを設定します。
    MyTbl.AutoFilter Field:=10, Criteria1:="<=" & MyDate
    '↓これが元になった記録のコードです。
    'Selection.AutoFilter Field:=10, Criteria1:="<=2004/12/20", Operator:=xlAnd
    'F8で実行しながらMyDateにマウスを近づけると変数の中身が見えますから
    '是非みてください。
    With .AutoFilter.Range
        'データが抽出されたかを判断します。
        If .Columns(1).SpecialCells(12).Cells.Count > 1 Then
            .PrintPreview  'プレビューです。.PrintOutとお好みで使い分けてください。
'            .PrintOut　←プレビューなしで印刷します。
        Else
            MsgBox "ありません"
        End If
    End With
    'オートフィルタモードを解除します。
    .AutoFilterMode = False
End With
'変数を開放します。
Set Wh1 = Nothing
Set MyTbl = Nothing
End Sub
シートの保護については
Me.Protect , , , , , True
↑
こんなコードを上のコードの中に追加していますので参考にしてください。
（SoulMan）

こんにちは。昨夜のうちに、レス頂いていたのですね。ありがとうございました。自分なりに考えてはみたものの、頭が痛くなり寝てしまいました。m( _ _ )m

朝起きて、見てSoulManさまに感謝しながら、私の希望のページ設定に変更させて頂きました。

 Dim Wh1 As Worksheet
 Dim MyTbl As Range
 Dim MyDate As String
 Set Wh1 = Sheets("未")
'抽出する日付を設定します。
 MyDate = Format(DateSerial(Year(Date), Month(Date), Day(Date) - 0), "yyyy/mm/dd")
With Wh1
    Set MyTbl = .Range("A101", .Range("A65536").End(xlUp)).Resize(, 11)
    '印刷に関する設定をします。
    With .PageSetup
        .PrintArea = MyTbl.Address
        .PrintTitleRows = "$1:$100"
    End With
    'オートフィルタを一旦解除します
    .AutoFilterMode = False
    'オートフィルタを設定します。
    MyTbl.AutoFilter Field:=10, Criteria1:="<=" & MyDate
    With .AutoFilter.Range
        'データが抽出されたかを判断します。
        If .Columns(1).SpecialCells(12).Cells.Count > 1 Then
           .PrintPreview  'プレビューです。
        Else
            MsgBox "ありません"
        End If
    End With
    'オートフィルタモードを解除します。
    .AutoFilterMode = False
End With
'変数を開放します。
Set Wh1 = Nothing
Set MyTbl = Nothing
End Sub

マクロを起動させますと、確かに今日より以前の期日のものだけが、印刷プレビューで出てきます。（すばらしい！）

しかし、今日の期日のデータが例えば5つしかない（1ページで収まる）のに、印刷プレビューが12ページ出てきます。2～11ページは罫線のみ。

何が影響しているのでしょうか？

また、保護についてですが、私以上にパソに不慣れな人が使うので、データ入力時には、不必要で重要な関数が入っている部分がある為、シートに保護をかけたいのです。従いまして、VBA起動時には、まず、最初に保護の解除を入れ、最後に保護をかけるようにしたいのです。

始めは、例えば「未」シートには、上記（▲部分）のように、組んでみたのですが、◎の所で止まってしまいます。何がいけないのでしょうか？

また、「済」から返品等により「未」になる場合があります。このため、"未"、"済"などと限定した言葉ではなく、Tenki_Sakiなどの言葉にし、どのシートにも使えて、また、今後シートが増えた時にも困らないようにしたいのですが･･･。

よろしく、お願い致します。

（あっちゃん）

また、UP0279で、ご使用なさっていらっしゃる「お試しボタン」なるものは、どのように作成するのでしょうか？

（あっちゃん）

 スレッドが長くなるのでここに貼り付けます。
シートモジュールに
Option Explicit
Private Sub Worksheet_Activate()
'UserInterfaceOnlyをTrueにしてユーザーの操作のみに保護を掛けます。
Me.Protect , , , , True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Wks As Worksheet
Dim tennki_saki As String
Dim MyRow As Long, C As Long
Dim MyFlag As Boolean
'UserInterfaceOnlyをTrueにしてユーザーの操作のみに保護を掛けます。
Me.Protect , , , , True
'ターゲットの列がA列以外か行が101行より小さかったら無効
If Target.Column <> 1 Or Target.Row < 101 Then Exit Sub
'ターゲットの複数選択を不可にする。
If Target.Count > 1 Then Exit Sub
'ターゲットのDeleteを無効
If Target.Value = "" Then Exit Sub
'転記先はターゲットの値
tennki_saki = Target.Value
'転記先が自分だったら無効
If Me.Name = tennki_saki Then Exit Sub
'画面の更新を停止
Application.ScreenUpdating = False
'イベントを無効にする。
    Application.EnableEvents = False
    'ワークシートをループ
    For Each Wks In Worksheets
        '転記先のシート名とターゲットの値が同じだったら（つまり、転記先のシートがあったら）
        If Wks.Name = tennki_saki Then
            'シートの有無を判定
            MyFlag = True
            '念の為、転記先のUserInterfaceOnlyをTrueにします。
            Wks.Protect , , , , True
            '転記先シートのB列を基準に最終行をOffset(1)で取得
            MyRow = Sheets(tennki_saki).Range("B65536").End(xlUp).Offset(1).Row
            With Me  '変数Cを列数分ループ
                For C = 1 To .Range("A6").End(xlToRight).Column
                    Sheets(tennki_saki).Cells(MyRow, C).Value = Cells(Target.Row, C).Value
                Next C
                '転記が完了したら、ターゲットを削除
                Target.EntireRow.Delete Shift:=xlUp
            End With
            '転記が完了したらループから抜ける
            Exit For
        End If
    Next
    'MyFlagがFalseだったら（シートがなかったら）
    If MyFlag = False Then
        MsgBox "転記先のシート　「" & tennki_saki & "」　は、ありません。" & Chr(13) & _
                "転記先のシート名が正しいかもう一度確認して下さい。", vbCritical, "Excelの学校　VBA"
    Else
        '削除した行分を補う。
        With Me
            .Range("A498").EntireRow.Copy Destination:=.Range("A497")
            .Range("A497").Insert Shift:=xlDown
            .Range("A101").Select
            .Protect , , , , True 'イベントを無効にしている間に行の挿入を行う為
                                    '保護が無効になってしまいますのでここで再度保護を掛けます。
        End With
    End If
    'イベントを有効にする。
    Application.EnableEvents = True
'画面の更新を解除
Application.ScreenUpdating = True
End Sub
ThisWorkBookモジュールに
Option Explicit
Private Sub Workbook_Open()
Dim Wh As Worksheet
'お試しボタンを作ります。
MyMenuBar
'画面の更新を停止
Application.ScreenUpdating = False
    'ワークシートを保護します。
    For Each Wh In Worksheets
        Wh.Protect , , , , True
    Next
'画面の更新を解除します。
Application.ScreenUpdating = True
End Sub
'終了前にMyComを開放します。
Private Sub Workbook_BeforeClose(CANCEL As Boolean)
    MySet
End Sub
標準モジュールに
Option Explicit
Dim MyClass As New Class1
Sub MyUnlockMsg()
    Set MyClass.MyCom = Application.CommandBars("Protection").Controls(1)
End Sub
Sub Auto_Open()
    MyUnlockMsg
End Sub
Sub MySet()
    Set MyClass.MyCom = Nothing
End Sub
Sub てすと()
Dim Wh1 As Worksheet
Dim MyTbl As Range
Dim MyDate As String
Set Wh1 = Sheets("未")
'抽出する日付を設定します。
MyDate = Format(Date, "yyyy/mm/dd")
'画面の更新を停止
Application.ScreenUpdating = False
With Wh1
    'UserInterfaceOnlyをTrueにしてユーザーの操作のみに保護を掛けます。
    .Protect , , , , True
    '保護下でのオートフィルタを有効にします。
    .EnableAutoFilter = True
    'データ範囲をMyTblに取得します。
    Set MyTbl = .Range("A101", .Range("A65536").End(xlUp)).Resize(, 11)
    '印刷に関する設定をします。
    With .PageSetup
        .PrintArea = MyTbl.Address
        .PrintTitleRows = "$1:$100" '←こうじゃないんですか？
    End With
    'オートフィルタを一旦解除します
      .AutoFilterMode = False
    'オートフィルタを設定します。
    MyTbl.AutoFilter Field:=10, Criteria1:="<=" & MyDate
    With .AutoFilter.Range
        'データが抽出されたかを判断します。
        If .Columns(1).SpecialCells(12).Cells.Count > 1 Then
            .PrintPreview  'プレビューです。
        Else
            MsgBox "ありません"
        End If
    End With
    'オートフィルタモードを解除します。
    .AutoFilterMode = False
End With
Application.ScreenUpdating = True
'変数を開放します。
Set Wh1 = Nothing
Set MyTbl = Nothing
End Sub
'お試しボタンを作るコードです。
Sub MyMenuBar()
Dim MyBar As CommandBar
Dim MyCtrl As CommandBarButton
On Error Resume Next
    CommandBars("お試しボタン").Delete
On Error GoTo 0
'TemporaryをTrueにして終了と同時に自動的に削除します。
Set MyBar = Application.CommandBars.Add("お試しボタン", , , True)
'MyCtrlをMyBarに追加します。
Set MyCtrl = MyBar.Controls.Add(msoControlButton)
With MyCtrl
    .Caption = "お試しボタン"
    .OnAction = "てすと" '実行するマクロ名です。
    .FaceId = 2892
    .Width = 80
End With
'お試しボタンを表示します。
Application.CommandBars("お試しボタン").Visible = True
End Sub
クラスモジュールに
Option Explicit
Public WithEvents MyCom As CommandBarButton
Private Sub MyCom_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
If ActiveSheet.ProtectContents = False Then
  MsgBox "シートの保護は自動的に設定されます。" & Chr(13) & _
                "個々に操作する必要はありません。。"
            CancelDefault = True
End If
End Sub
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0283.xls
（SoulMan）

お出かけ前にありがとうございました。

 １．シート解除について
 　　シートは、データ入力時には保護の状態にしていたい、のです。
 　　つまり、マクロのスタート時には、まず、保護解除からさせたいのです。
 　　Unprotectからはじまるのではないのでしょうか？（私の認識不足？）
 　　また、保護解除を転記元、転記先両方解除してマクロを進めているつもりなのに、何故◎の所で止まるのでしょうか？

 ２．印刷に関しましては
 　　私が、作成した表の中には、ﾌﾘｶﾞﾅ（C列）を表示させるための関数（VLOOKUP）がフォーマット済の部分５００行分入力されています。
 　　これが原因なのかな？と思い削除してみたら、SoulManさまのおっしゃる通り今日のデータのみ印刷プレビューに出てきます。
 　　しかし、業者には並んでほしい順があり、それを含んだキーﾜｰﾄﾞを入れてﾌﾘｶﾞﾅにしています。
 　　このﾌﾘｶﾞﾅの関数を無視して、納期日のみを判断基準にすることはできないのでしょうか？

 ３．印刷ページ設定について
 　　ご指摘を頂戴致しました行のタイトルですが、会社名、注意事項文等が入っていて、A1～A100までを行のタイトルとしました。
 　　また、中間の3～96行めまでは、「表示しない」にさせています。m( _ _ )m

 ４．「お試しボタン」作成方法について
 　　分かりました。すみませんでした。

 上記３つについて、また教えていただけませんでしょうか？
 また、私のフォーマット通りUp0282を作成して頂きありがとうございました。
 やはり、２．の項目が原因なんだな～と再確認しました。

 お時間を、いつも頂き申し訳ありません。
 何卒、よろしくお願い致します。

（あっちゃん）

 お試しボタンを見たということはサンプルはDLしたんでしょ？
サンプルup0282.xlsは止まらないでしょ？
すみません。悪いところがわかりました。
スレッドが長くなるので上のコードで修正しています。
色々なモジュールを使っていますので注意して貼り付けてください。
帰ったらサンプルもアップします。 
 >フォーマット済の部分５００行分入力されています
 これがよくわかりませんが、VLOOKUPで抽出するのなら別シートの出来ませんか？
（SoulMan）

 　はい、DLさせて頂きました。

 　本当だ！ごめんなさい。止まらない！
 　勘違いをしていました。
 　ちょっと、出かけてきますので、ゆっくりと夜見せて下さい。
 　申し訳ありません。
　 更新をしようとする度、SoulManさまが編集して下さっているようですね。
 　帰ったら、バカな頭で考えますので、ちょっとお待ちを。m( _ _ )m

（あっちゃん）

 こんばんは！
 一応上のコードを修正しておきました。
 非表示にしておけば100行のタイトルもいいみたいだけど、どうかな？
 >フォーマット済の部分５００行分入力されています
 私にはレイアウトが見えませんので、なんともいえませんが、
 印刷範囲を指定しているので問題ないと思うのですがぁ？？
 どうでしょうか？
（SoulMan）

 こんばんは！
 SoulManさまは、何事も早いですね、
 私が、３時間もかかって、編集にかかっているうちに、またレスを頂戴しまして。
 ごめんなさい。

 修正して頂いたものを、今一度見せて頂きます。
 とりあえず、３時間かかって書いたものを登録させて下さい。m( _ _ )m

　色々なモジュールに、いっぱいのVBAありがとうございました。

 １．お蔭様で上記の１．に関しましては、大大満足です。
 　こんな事できるのですね。

 　ただ、残念な事に、「マクロの記録」を利用して、「業者順」と「日付順」というプログラム（？）があったのが、作動しなくなりました。
 　いつも、いつも後から希望で申し訳ないのですが･･･。
 　シートモジュールには
 　　「未」シートの転記VBAの後ろに → 日付順
 　　　　　　　　　　　　　　　　 　シートがセレクトされたら、日付→業者名順にソートがかかるように
 　　「済」シートの転記VBAの後ろに → 日付順
 　　　　　　　　　　　　　　　　　 シートがセレクトされたら、日付→業者名順にソートがかかるように

 Option Explicit
Private Sub Worksheet_Activate()
'シートを保護するのは↓のコードでいいと思います。
Me.Protect , , , , True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tennki_saki As String
Dim Wks As Worksheet
Dim MyRow As Long
Dim C As Integer, i As Integer
'シートを保護するのは↓のコードでいいと思います。
Me.Protect , , , , True
'ユーザーの操作のみを保護するものですから、マクロの操作は保護されません。
'ターゲットの列がA列以外か行が101行より小さかったら無効
If Target.Column <> 1 Or Target.Row < 101 Then Exit Sub
'ターゲットの複数選択を不可にする。
If Target.Count > 1 Then Exit Sub
'ターゲットのDeleteを無効
If Target.Value = "" Then Exit Sub
'転記先はターゲットの値
tennki_saki = Target.Value
'転記先が自分だったら無効
If Me.Name = tennki_saki Then Exit Sub
 'イベントを無効にする。
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 'ワークシートをループ
    For Each Wks In Worksheets
    '変数ｉを初期化
    i = 0
        '転記先のシート名とターゲットの値が同じだったら（つまり、転記先のシートがあったら）
        If Wks.Name = tennki_saki Then
            '転記先シートのB列を基準に最終行+1を取得
            Wks.Protect , , , , True
            MyRow = Sheets(tennki_saki).Range("B65536").End(xlUp).Row + 1
                With Me  '変数Cを列数分ループ
                    For C = 1 To .Range("A6").End(xlToRight).Column
                        Sheets(tennki_saki).Cells(MyRow, C).Value = Cells(Target.Row, C).Value
                    Next C
                        '転記が完了したら、ターゲットを削除
                        Target.EntireRow.Delete Shift:=xlUp      '←◎
                End With
            '転記が完了したらループから抜ける
            Exit For
        End If
        '変数iに1を代入してシートの有無を確認
        i = 1
    Next
    '変数iが0じゃなかったら
    If i <> 0 Then
        MsgBox "転記先のシート　「" & tennki_saki & "」　は、ありません。" & Chr(13) & _
                "転記先のシート名が正しいかもう一度確認して下さい。", vbCritical, "Excelの学校　VBA"
    Else
        '移行した行分を補う。
        With Me
            .Range("A498").EntireRow.Copy Destination:=.Range("A497")
            .Range("A497").Insert Shift:=xlDown
            .Range("A101").Select
            .Protect , , , , True 'イベントを無効にしている間に行を挿入しているので
                                    '保護が無効になっていますのでここで再度保護を掛けます。
        End With
    End If
 'イベントを有効にする。
 Application.EnableEvents = True
 Application.ScreenUpdating = True
 End Sub

Private Sub Worksheet_Activate1()
'シートを保護するのは↓のコードでいいと思います。
Me.Protect , , , , True
End Sub
Private Sub Worksheet_Activate2()

 '日付順になおす。
 Application.ScreenUpdating = False
    Range("A100").CurrentRegion.Sort Key1:=Range("J101"), Order1:=xlAscending, Key2:=Range( _
        "C101"), Order2:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
  .Protect , , , , True
 End Sub

 　標準モジュールには
 　　日付順（日付、業者名順）（データ入力時、閲覧のみの時に使用するように）
 　　業者順（業者名、日付順）（データ入力時、閲覧のみの時に使用するように）
 　でも、みんな効かなくなっちゃったのです。
 　UP0279で超カッコよかったので、オブジェクトにマクロ登録したボタン２種類（日付順、業者順）を作り、よろこんでいたのですが･･･。（T_T）
 　どうしたらよいのでしょうか？

 また、印刷時には、日付順にソートをかけた後で、オートフィルタをかけたいのです。

 Sub MyUnlockMsg()
    Set MyClass.MyCom = Application.CommandBars("Protection").Controls(1)
End Sub
Sub Auto_Open()
    MyUnlockMsg
End Sub
Sub MySet()
    Set MyClass.MyCom = Nothing
End Sub
Sub 印刷() ←SoulManさまは「てすと」命名
Dim Wh1 As Worksheet
Dim MyTbl As Range
Dim MyDate As String
Set Wh1 = Sheets("未")
'日付、業者順にソートをかける。
  Range("A100").CurrentRegion.Sort Key1:=Range("J101"), Order1:=xlAscending, Key2:=Range( _
        "C101"), Order2:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
'抽出する日付を設定します。
MyDate = Format(Date, "yyyy/mm/dd")
With Wh1
    .Protect , , , , True
    .EnableAutoFilter = True
    Set MyTbl = .Range("A101", .Range("A65536").End(xlUp)).Resize(, 11)
    '印刷に関する設定をします。
    With .PageSetup
        .PrintArea = MyTbl.Address
        .PrintTitleRows = "$1:$100" 
    End With
    'オートフィルタを一旦解除します
      .AutoFilterMode = False
    'オートフィルタを設定します。
    MyTbl.AutoFilter Field:=10, Criteria1:="<=" & MyDate
    With .AutoFilter.Range
        'データが抽出されたかを判断します。
        If .Columns(1).SpecialCells(12).Cells.Count > 1 Then
            .PrintPreview  'プレビューです。
        Else
            MsgBox "ありません"
        End If
    End With
    'オートフィルタモードを解除します。
    .AutoFilterMode = False
End With
'変数を開放します。
Set Wh1 = Nothing
Set MyTbl = Nothing
End Sub

Sub 日付順()

'
' Macro1 Macro
' マクロ記録日 : 2005/4/12 ユーザー名 : user
'
'

 Application.ScreenUpdating = False
    Range("A100").CurrentRegion.Sort Key1:=Range("J101"), Order1:=xlAscending, Key2:=Range( _
        "C101"), Order2:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
 Application.ScreenUpdating = True
 End Sub

Sub 業者順()

'
' 業者順 Macro
' マクロ記録日 : 2005/4/12 ユーザー名 : user
'
'

    Application.ScreenUpdating = False
    Range("A100").CurrentRegion.Sort Key1:=Range("C101"), Order1:=xlAscending, Key2:=Range( _
        "J101"), Order2:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
 Application.ScreenUpdating = True
 End Sub

 ２．５００行のフォーマットの件ですが、B列の業者名（例B101）がリスト入力により入力されたら、同シート内の表（M5～N98）（M列は業者名、N列はｷｰﾜｰﾄﾞ入りﾌﾘｶﾞﾅ）により、C列のﾌﾘｶﾞﾅ（例C101）が入力されるという関数が入っています。
 例 C101のセルには
 　　=IF(ISERROR(VLOOKUP(B101,$M$5:$N$98,2,FALSE)),"",VLOOKUP(B103,$M$5:$N$98,2,FALSE))
 何とか、解決策はあるのでしょうか？

 色々、申し訳ありません。
 よろしく、お願い致します。

（あっちゃん）

 困りましたね。長くなって私もよくわかりません。
 一応これでいいと思いますがどうでしょうか？
 それから
 >５００行のフォーマットの件ですが、
なぜ？データベースの先頭100行にこの様なのもがあるのか理解できません。
 もともとフィールド（見出し）は一行で項目が特定できれば十分です。
↓この式も
=IF(ISERROR(VLOOKUP(B101,$M$5:$N$98,2,FALSE)),"",VLOOKUP(B103,$M$5:$N$98,2,FALSE))
$M$5:$N$98この範囲を別シートに作ればいいだけではないのですか？
基本的な仕様の変更を考えられた方がいいように思います。
どうでしょうか？
ここからコードの修正記事になります。
Activateの1とか2とかは出来ません。名前を勝手に変えてはいけません。
Private Sub Worksheet_Activate()
'シートを保護するのは↓のコードでいいと思います。
Me.Protect , , , , True
 '日付順になおす。
 Application.ScreenUpdating = False
    Range("A100").CurrentRegion.Sort _
        Key1:=Range("J101"), Order1:=xlAscending, _
        Key2:=Range("C101"), Order2:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlPinYin
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
の方はサンプルで問題ないと思いますので割愛させていただきます。
標準モジュールはこれでいいと思いますがどうでしょうか？
Option Explicit
'標準モジュールには
'日付順（日付、業者名順）（データ入力時、閲覧のみの時に使用するように）
'業者順（業者名、日付順）（データ入力時、閲覧のみの時に使用するように）
'でも､みんな効かなくなっちゃったのです｡
'UP0279で超カッコよかったので、オブジェクトにマクロ登録したボタン２種類（日付順、業者順）を作り、
'よろこんでいたのですが･･･。（T_T）
'どうしたらよいのでしょうか？
'また､印刷時には､日付順にソートをかけた後で､オートフィルタをかけたいのです｡
Sub MyUnlockMsg()
    Set MyClass.MyCom = Application.CommandBars("Protection").Controls(1)
End Sub
Sub Auto_Open()
    MyUnlockMsg
End Sub
Sub MySet()
    Set MyClass.MyCom = Nothing
End Sub
Sub 印刷() '←SoulManさまは「てすと」命名
Dim Wh1 As Worksheet
Dim MyTbl As Range
Dim MyDate As String
Set Wh1 = Sheets("未")
'抽出する日付を設定します。
MyDate = Format(Date, "yyyy/mm/dd")
With Wh1
    .Protect , , , , True
    .EnableAutoFilter = True
    '日付、業者順にソートをかける。
    .Range("A100").CurrentRegion.Sort _
                    Key1:=.Range("J101"), Order1:=xlAscending, _
                    Key2:=.Range("C101"), Order2:=xlAscending, _
                    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
                    Orientation:=xlTopToBottom, SortMethod:=xlPinYin
    Set MyTbl = .Range("A101", .Range("A65536").End(xlUp)).Resize(, 11)
    '印刷に関する設定をします。
    With .PageSetup
        .PrintArea = MyTbl.Address
        .PrintTitleRows = "$1:$100"
    End With
    'オートフィルタを一旦解除します
      .AutoFilterMode = False
    'オートフィルタを設定します。
    MyTbl.AutoFilter Field:=10, Criteria1:="<=" & MyDate
    With .AutoFilter.Range
        'データが抽出されたかを判断します。
        If .Columns(1).SpecialCells(12).Cells.Count > 1 Then
            .PrintPreview  'プレビューです。
        Else
            MsgBox "ありません"
        End If
    End With
    'オートフィルタモードを解除します。
    .AutoFilterMode = False
End With
'変数を開放します。
Set Wh1 = Nothing
Set MyTbl = Nothing
End Sub
Sub 日付順()
' ' Macro1 Macro ' マクロ記録日 : 2005/4/12 ユーザー名 : user ' '
Application.ScreenUpdating = False
    Range("A100").CurrentRegion.Sort _
        Key1:=Range("J101"), Order1:=xlAscending, _
        Key2:=Range("C101"), Order2:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlPinYin
Application.ScreenUpdating = True
End Sub
Sub 業者順()
' ' 業者順 Macro ' マクロ記録日 : 2005/4/12 ユーザー名 : user ' '
Application.ScreenUpdating = False
    Range("A100").CurrentRegion.Sort _
        Key1:=Range("C101"), Order1:=xlAscending, _
        Key2:=Range("J101"), Order2:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlPinYin
Application.ScreenUpdating = True
End Sub
（SoulMan）

 ありがとうございました。

 先頭100行に、業者名、ﾌﾘｶﾞﾅをもっていったのは、
 　転記したりする時に障害となるのでは？
 　メンテの時に、データ行の削除などしても誤って消さないか？
 という点から、可能性がない先頭100行に、業者名、ﾌﾘｶﾞﾅをもっていったのです。
 印刷は印刷範囲指定で、1ページ～○ページと入力するようにします。
 印刷プレビューが出ているので、○ページと入力しやすいです。v(~~)v

 お蔭様で、私の希望通りに、転記、印刷、日付順、業者順など、快適に動いてくれています。m( _ _ )m

 こんなに天気のよい日に、貴重なお時間頂戴しまして、本当にありがとうございました。
 保護の方法に、びっくりしました。
 本当に、ありがとう。

 （あっちゃん）

 なんとか？無理やり？解決したみたいでよかったです(^^;
 >基本的な・・・
 くれぐれも気分を悪くなさらないでくださいましね。
 あっちゃんさんの事情もあるでしょうからね。
 また何かあったらいつでも聞いてください。
 私のわかる範囲でお答えしますので・・
 ではでは、v(=∩_∩=)v
（SoulMan）

 こんにちは。（書き始めた頃は、おはようございます！だったのに）
 SoulManさま、私は気分を悪くするどころか、感謝の気持ちでいっぱいです。
 申し訳ないのですが、もうちょっと、お付き合いいただけませんか？
 よろしくお願い致します。

 １．「500行」という量は、普通ならデータ3ヶ月が入力できる量です。
 　　　万一、大量に注文が来た時、または作業者がA列の「未」「済」の変更を怠った時でもよいように（まず無いことですが･･･）という考えから、
 　　　500行分をフォーマットしておこうと思ったのです。
  　　その為、
     　   '移行した行分を補う。←▲▲
        With Me
            .Range("A498").EntireRow.Copy Destination:=.Range("A497")
            .Range("A497").Insert Shift:=xlDown
            .Range("A101").Select
            .Protect , , , , True
 　　のA498をコピーし、コピーしたものを挿入するということにしたかったのです。

 　　ですが、VBAなら
 　　データの最終行をコピー（関数やセルの色の変化をさせる条件付き書式が設定されているから最終行のコピー）し、
 　　その1行前に挿入させることができますよね。
　　　但し、データの最終行をセルのロックをかけておいて削除されないなど安全策を考えなければなりませんが。
 　　それって、上のコード▲▲を下記のように変更しただけではダメなんですね。
　 　'移行した行分を補う。
        With Me
            .Range("B65536").End(xlUp).Copy Destination:=.Range("B65536").End(xlUp).ROW - 1
            .Range("B65536").End(xlUp).ROW - 1.Insert Shift:=xlDown
            .Range("A101").Select
            .Protect , , , , True
 　　悲しい事に挿入部分
            .Range("B65536").End(xlUp).ROW - 1.Insert Shift:=xlDown
 　　が赤くなり、先に進めなくなりました。(T_T)
 　　どのようにしたらよいのでしょうか？

 ２．また、500行のフォーマットを止め、最小限の行のみにしたとして、
 　　新規データ入力時に行が必要になった時の為に、オブジェクトのボタンを2つ作り、
 　　例えば、最終行をコピーしその最終行の前に1行分挿入とか5行挿入とか選択できるようにしたいと思います。
  　 お手数ですが、是非教えて下さい。

 　　１．と２．をすれば、印刷プレビューが、今日以前のデータ + 1 程度で終わるはずですよね。

 ３．それから･･･
 　　エクセルのこのファイルを閉じ、再び開けると
 　　標準モジュールに　
 　　　Sub MyUnlockMsg()
　     Set MyClass.MyCom = Application.CommandBars("Protection").Controls(1) '←黄色
 　　　End Sub
 　　になります。SoulManさまのUP0283はならないのに･･･。
 　　また、閉じようとすると
  　　　Sub MySet()
     　　　Set MyClass.MyCom = Nothing   '←黄色
 　　　　End Sub
 　　これは、ThisWorksbookモジュールのお試しボタン部分●●を消したから？でしょうか？
 　　　Option Explicit
 　　　Private Sub Workbook_Open()
 　　　Dim Wh As Worksheet
 　　　'お試しボタンを作ります。←●●
 　　　MyMenuBar　　　　　　　　←●●
 　　　'画面の更新を停止
 　　　Application.ScreenUpdating = False
    　　'ワークシートを保護します。
    　 For Each Wh In Worksheets
         Wh.Protect , , , , True
    　 Next
 　　'画面の更新を解除します。
 　　　Application.ScreenUpdating = True
 　　　End Sub
 　　'終了前にMyComを開放します。
 　　Private Sub Workbook_BeforeClose(CANCEL As Boolean)
    　MySet
 　　End Sub

 　　すみません。もう1度教えて下さい。

（あっちゃん）

 どうもそこがおかしいと思っていましたが、以下でどうでしょうか？
'削除した行分を補う。
With Me
    With .Range("A65536").End(xlUp)
        .EntireRow.Copy
        .EntireRow.Insert Shift:=xlDown
        Application.CutCopyMode = False
    End With
    .Range("A101").Select
    .Protect , , , , True 'イベントを無効にしている間に行の挿入を行う為
                            '保護が無効になってしまいますのでここで再度保護を掛けます。
End With
それからお試しボタンにかかわる部分は必要なければ消しちゃってください。
あっごめんなさい。
 >最終行をコピーしその最終行の前に1行分挿入とか5行挿入とか
 >選択できるようにしたいと思います。
 これを見逃していました。
これで最終行をコピー出来ますが、5行挿入の場合は5回実行してください。(^^;
というのは冗談の様な本気の様な？？？
選択出来る様にするのは簡単だけど、あまり意味ない様な？？
どうでしょうか？
Option Explicit
Sub てすと()
With ActiveSheet.Range("A65536").End(xlUp)
    .EntireRow.Copy
    .EntireRow.Insert Shift:=xlDown
    Application.CutCopyMode = False
End With
End Sub
こうしたら、五行挿入です。
Sub 五行挿入()
With ActiveSheet.Range("A65536").End(xlUp).Offset(-5).Resize(6)
    .EntireRow.Copy
    .EntireRow.Insert Shift:=xlDown
    Application.CutCopyMode = False
End With
End Sub
（SoulMan）

 SoulManさまって、本当に早いですね。

 「お試しボタンは･･･」で、一度SoulManさまのレスを見せて頂き、
  削除した行分を補う　コードをコピーさせて頂き貼り付けてみて、色々試させていただいておりました。
 500行フォーマットをやめた上で、新しいコードにした時、
 A列を「未」→「済」に変更した時はいいのですが、「済」→「未」の時、罫線がなくなる！などの弊害が出てきて、苦慮しておりました。(^^A
 今回、罫線のみの空行を設ける事にして解決しました。
 （行には条件付き書式にて「VLOOKUPのデータが無い事」ことを注意を促す）

 　そして、五行挿入も自分なりに考えてみましたが･･･。
 　Sub 五行挿入()
With ActiveSheet.Range("A65536").End(xlUp)
    .EntireRow.Copy
    .EntireRow.Insert Shift:=x5Down　'←● １ → ５ に変更しただけ
    Application.CutCopyMode = False
End With
End Sub
   　●だけでは、ダメなんですね。（マクロ名の五も５ではダメなんですね）

 SoulManさまの
 　Sub 五行挿入()
 　With ActiveSheet.Range("A65536").End(xlUp).Offset(-5).Resize(6)
    .EntireRow.Copy
    .EntireRow.Insert Shift:=xlDown
    Application.CutCopyMode = False
 　End With
 　End Sub
 は、最終行から上に５行コピーし挿入するのですよね。
 勝手言って申し訳ないのですが、最終行１行を５行分挿入したいのです。

 それから･･･
   エクセルのこのファイルを閉じ、再び開けると
 　　実行エラー「424」
 　　オブジェクトが必要です
 　と出ます。

 　　標準モジュールに　
 　　　Sub MyUnlockMsg()
　     Set MyClass.MyCom = Application.CommandBars("Protection").Controls(1) '←黄色
 　　　End Sub
 　　になります。SoulManさまのUP0283はならないのに･･･。
 　　また、閉じようとすると
  　　　Sub MySet()
     　　　Set MyClass.MyCom = Nothing   '←黄色
 　　　　End Sub

 どうしたらいいのでしょうか？

（あっちゃん）

 5回繰り返してください。
Sub 五行挿入()
Dim i As Long
For i = 1 To 5
    With ActiveSheet.Range("A65536").End(xlUp)
        .EntireRow.Copy
        .EntireRow.Insert Shift:=xlDown
        Application.CutCopyMode = False
    End With
Next i
End Sub
黄色くなったところは消してください。
（SoulMan）

 こんばんは！進んでますか？
お試しボタンのコードだけをまとめてみましたので参考にしてください。
お試しボタンのニューバージョンです。色々登録出来る様にしてみました。
いらない時はThisWorkBookの
「お試しボタンをつくるコードです」
だけを削除すればいいです。そうすれば作りませんから・・・
ThisWorkBookのモジュールに
Option Explicit
Private Sub Workbook_Open()
'Bookを開く時に↓が実行されてお試しボタンを作ります。
'不要になったら消してください。
お試しボタンをつくるコードです
End Sub
標準モジュールに
Option Explicit
Sub お試しボタンをつくるコードです()
Dim MyBar As CommandBar
Dim MyCtrl As CommandBarComboBox
On Error Resume Next
    CommandBars("お試しボタン").Delete
On Error GoTo 0
Set MyBar = Application.CommandBars.Add("お試しボタン", , , True)
Set MyCtrl = MyBar.Controls.Add(msoControlDropdown)
With MyCtrl
    .AddItem "てすと1", 1 'どんどん追加してください。
    .AddItem "てすと2", 2 'どんどん追加してください。
    .AddItem "てすと3", 3 'どんどん追加してください。
    .ListIndex = 1
    .Caption = "お試しボタン"
    .OnAction = "お試しボタン"
    .Width = 80
End With
Application.CommandBars("お試しボタン").Visible = True
End Sub
Private Sub お試しボタン()
Select Case Application.CommandBars("お試しボタン").Controls(1).ListIndex
    Case 1
        MsgBox "てすと1を選択しました" 'ここに実行したいマクロ名を書きます。
    Case 2
        MsgBox "てすと2を選択しました" 'ここに実行したいマクロ名を書きます。
    Case 3
        MsgBox "てすと3を選択しました" 'ここに実行したいマクロ名を書きます。
End Select
Application.CommandBars("お試しボタン").Controls(1).ListIndex = 1
End Sub
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0285.xls
（SoulMan）

 SoulManさま、やっぱり早い！

 黄色の所は、消してということですが、全部（日付順も業者順も印刷も）動かなくなってしまいました。
 今一度、ゆっくりとUP00283と見比べてみましたら、標準モジュールの1行めが抜けていました。
 全部コピーして張り付けたつもりだったのに･･･。(^^A
 落ちかなくては！
 全部チェックして、もれがないようにして、マクロを実行せてたら今度はOKでした。
 大変、お騒がせいたしました。

 お試しボタンですか～！
 UP0285を拝見させて頂きました。
 ▽で選べるなんてすご～い！！
 是非、今度使わせて頂きます。
 上のように、応用が効くように書いて下さると大変うれしいです。

 大事な数日、数十時間、私のためにありがとうございました。
 私の希望全部叶った最高のVBAをありがとうございました。

（あっちゃん）

 あっちゃんさん、すみません。お詫びと訂正です。
オートフィルタの抽出条件の部分なのですが、
日付に対してはやはりシリアル値で対応するのが正当なので
文字列型として宣言している
↓これを
Dim MyDate As String
↓長整数型のLongに変更してください。
Dim MyDate As Long
更に
文字列に変換している↓を
MyDate = Format(Date, "yyyy/mm/dd")
↓とか
MyDate = DateSerial(Year(Date), Month(Date), Day(Date))
ただ単に
↓
MyDate = Date
とかに変更してください。
実は、私も以前から気になっていたのですが、他の方の誤解の元になってもいけませんので、
訂正させてください。ではでは、大変失礼しました。m(__)m
（SoulMan）

コメント返信：

[ 一覧(最新更新順) ]

[[20050414215944]] 『納期管理表－今日までのデータ印刷実行』（あっちゃん） ページの最後に飛ぶ

[[20050414215944]]　『納期管理表－今日までのデータ印刷実行』（あっちゃん）　ページの最後に飛ぶ