| |
御忙しい所、申し訳ございません。
下記のマクロを作成しましたがうまく動きません。
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
|
|
サン
- 06/6/22(木) 10:59 -
