VBAの質問です。（初心者です。。。）

質問

VBAの質問です。（初心者です。。。）

”作成ファイル”には複数のシート（時系列）があり、それぞれのシートに縦（ラベルA）、横（ラベルB）のデータ値が入っています。
それをVBAによって、シート（ラベルA）、縦（時系列）、横（ラベルB）となる新しい”リスク分析”ファイルを作成します。

現在出るエラーは
「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」
です。

実行すると”リスク分析”ファイルを新たに作成するところまではできているのですが、そこから新しいシートを追加する前で止まっています。（そのあたりで間違いいがあると考えられます。）

考えられる原因を教えていただけないでしょうか。

以下プログラム

Sub riskfile()

Dim ddd As Long
ddd = Format(Date, "yyyymm")

Dim ttt As Long
ttt = Format(Time, "hhnnss")

Dim Newbook As Workbook
Set Newbook = Workbooks.Add
Newbook.SaveAs Filename:="リスク分析" & ddd & ttt

Workbooks("作成ファイル").Worksheets(2).Activate

Dim span As Integer
span = Workbooks("作成ファイル").Sheets.Count - 1 '作成ファイルのシート数（時系列）

Dim month As Integer
Dim portfolio As Integer

For portfolio = 1 To 16 '新しいシートを追加し、シートに名前（ラベルA）を定義

Dim portname As String

portname = Workbooks("作成ファイル").Worksheet(2).Cells(portfolio, 3) 'ラベルAの名前を定義

Workbooks("リスク分析" & ddd & ttt).Activate

Dim NewWS As Worksheet

Set NewWS = Workbooks("リスク分析" & ddd & ttt).Worksheets.Add(before:=Worksheets("Sheet1"))

NewWS.Name = portname

For month = 1 To span '作成ファイルの時系列シートから各ラベルAのデータ行を抽出し、リスク分析ファイルのラベルAシートへ貼り付け

Workbooks("作成ファイル").Worksheet(month).Range(portfolio & ":" & portfolio) _
.Copy Destination:=Workbooks("リスク分析" & ddd & ttt).Worksheet(1).Range(month & ":" & month)

Next month

Next portfolio

End Sub

回答No.2

imogasi · ベストアンサー

#1でご指摘の外にもWorksheetsをWorksheetとしている個所が数箇所ある。
このブックの、ワークシートのコレクションというものなので、Worksheetsです。ブックも同じく
Workbooksです。オブジェクトのコレクションと言うものを勉強すること。
コレクションの特定は
名前
インデックス番号
その他　Ａｃｔｉｖｅ・・やシートではＰｒｅｖｉｏｕｓ、Ｎｅｘｔ（ActiveSheet.Previous
など）が使える。LastはなくSheets(ActiveWorkbook.Sheets.Count）で代用する。
ーーー
この方法（ActiveWorkbook.Sheets.Count）で代用できるから　span などの変数を使わなくても良いと思う。
使うとコードが冗長になる。この場合はわかりやすくなるともいえない。ActiveWorkbook.Sheets.Countのほうが意味を推測しやすい。
ーー
”リスク分析”ファイルなどと難しそうに銘打っているが、（たまたまそういうことに使うデータで会っただけでしょう）質問の場合は、１つのブックと言うことで、説明して良いのでは。読む方は何かと身構えるがリスク分析そのものと関係ないでしょう。。
ここでやっているのがファイルのコピーと日付を入れた名前づけだけではないですか。質問ももっとかんたんになり、コードも短く出来るように思った。

お礼

ご対応、及びご指摘ありがとうございました。

プロージャーをそのまま貼り付けたことでわかりずらくなったことは確かです。申し訳ございません。

時間がなかったことと、意外なところに問題があるのではと考え、そのまま貼り付けました。

回答No.1

kmetu

portname = Workbooks("Book2").Worksheet(2).Cells(portfolio, 3) 'ラベルAの名前を定義

Worksheet(2)
Worksheets(2)

です。

デバッグでステップイン実行すれば容易に分かるところですよ。

お礼

ありがとうございます。無事解決いたしました。

＞デバッグでステップイン実行すれば容易に分かるところですよ。

このような基本動作も使用せずに質問してしまいました、申し訳ございません。