| 
    
     |  | 御忙しい所、申し訳ございません。 下記のマクロを作成しましたがうまく動きません。
 2006/7の入金予定分を他のシートにコピーしたいのですが
 教えて頂けますでしょうか。
 
 宜しくお願い致します。
 
 Sub データ抽出販売()
 '---------------------------宣言セクション(各項目 最大1000件まで格納する)---
 Dim 顧客コード(1000) As String
 Dim 顧客名(1000) As String
 Dim 部署(1000) As String
 Dim 担当者(1000) As String
 Dim 売上日(1000) As Date
 Dim 伝票番号(1000) As Single
 Dim 売上金額(1000) As Single
 Dim 未収金額(1000) As Single
 Dim 備考(1000) As String
 Dim 入金予定(1000) As Date
 Dim 入金情報(1000) As String
 Dim 当社担当(1000) As String
 Dim UHNAMK(1000) As String
 
 
 Dim n As Integer
 Dim m As Integer
 Dim i As Integer
 
 Dim mstr As String
 
 
 '-----------------------メッセージボックスの表示------------------------------
 mstr = InputBox("何月分を抽出しますか?(数字のみ)", "抽出月指定")
 
 '----------------------該当データを一旦メモリ上に格納する---------------------
 Sheets("販売").Select
 n = 0
 Range("J1").Select
 
 Do While ActiveCell <> "" '----------A列で空欄がくるまで繰り返す
 
 If Month(ActiveCell) = Val(mstr) Then '----メッセージボックスで入力した月のデータを格納
 顧客コード(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 顧客名(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 部署(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 担当者(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 売上日(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 伝票番号(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 売上金額(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 未収金額(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 備考(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 入金予定(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 入金情報(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 当社担当(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, 1).Select
 UHNAMK(n) = ActiveCell.Cells.Value
 ActiveCell.Offset(0, -12).Select
 
 
 n = n + 1
 Else
 
 End If
 ActiveCell.Offset(1, 0).Select
 Loop
 
 
 '----------------------抽出シート作成----------------------------------------
 
 Sheets.Add After:=Worksheets(Worksheets.Count) '----------シート挿入
 ActiveSheet.Name = mstr & "月分"        '----------シート名
 
 
 ActiveSheet.Range("A1").Select
 
 ActiveCell.Cells.Value = "顧客コード"     '----------項目名
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "顧客名"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "部署"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "担当者"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "売上日"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "伝票番号"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "売上金額"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "未収金額"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "備考"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "入金予定"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "入金情報"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "当社担当"
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = "UHNAMK"
 ActiveCell.Offset(1, -13).Select
 
 
 For i = 0 To n - 1              '-----------メモリ上に格納していたデータを代入
 ActiveCell.Cells.Value = 顧客コード(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 顧客名(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 部署(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 担当者(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 売上日(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 伝票番号(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 売上金額(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 未収金額(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 備考(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 入金予定(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 入金情報(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = 当社担当(i)
 ActiveCell.Offset(0, 1).Select
 ActiveCell.Cells.Value = UHNAMK(i)
 ActiveCell.Offset(1, -13).Select
 
 
 Next i
 
 ActiveSheet.Range("A1").Select
 
 
 End Sub
 
 |  |