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

前提・実現したいこと

Set ws1 = Sheet1("一覧") の部分に「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」というエラーの矢印が出て、調べたのですが解決できなかったため、どうすれば解決できるのかコード付きで質問させていただきました。"一覧"シートにあるそれぞれの人物の情報を"紹介"シートに反映させ、1人につき1つのExcelファイルへ情報を反映した"紹介"シートを保存するマクロを作りたいです。ただしマクロ実行時、上記の画像の[Excel 一括保存][PDF 一括保存]にコマンドボタンを置き、実行します。Excelのファイルの保存は任意の場所でファイル名は"所属_氏名"です。

Sub 一括保存()
    Dim ws1 As Worksheet '変数宣言
    Dim ws2 As Worksheet '変数宣言
    Set ws1 = Sheet1("一覧") '変数ws1にシート[一覧]を代入
    Set ws2 = Sheet2("紹介") '変数ws2にシート[紹介]を代入

    Dim wb As Workbook, Target As String
    Dim i '変数宣言
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Target = Cells(i, 1)
        ws2.Name = Target
        ws2.Copy 'シート[紹介]を別ブックとしてコピー
        ActiveWorkbook.SaveAs "C:\紹介.xlsx"
        ActiveWorkbook.Close
    Next i
End Sub

BeatStar

2021/08/05 13:41

なんで自分でやらない？ここは課題代行ではないです。せめてその手のところに『カネを払って』やってもらいましょう。自分は努力せず、他人に無報酬で労力を強いる。その上、『なる早で』。赤の他人を舐めすぎ。同じことを他人にされて『わかりました。引き受けましょう』となるのでしょうか。そんな聖人君子様なら丸投げな上に『なる早で』なんてやりません。つまり『あまりにも身勝手』。まずは自分なりにやって、コード等を提示しましょう。

meg_

2021/08/05 13:55

> 明日の午後には提出しなければいけないため課題か業務か分かりませんが正直に「出来ませんでした」と伝えた方が良いのではないですか？

退会済みユーザー

2021/08/09 13:02

[推奨していない質問] https://teratail.com/help/avoid-asking > コードをください・デバッグしてください等の丸投げの質問何かを作りたいのでコードを書いてほしい、学校の課題を解いてほしい等の質問は、具体的にプログラミングで困っている質問ではないと考え、推奨していません。

BeatStar

2021/08/10 06:51

ちゃんと「一覧」という名前のシートがありますか? それと Sheet1( "一覧" ) ではなく、Sheets( "一覧" ) では?

kitagawas

2021/08/10 07:29

はい、「一覧」という名前のシートはあります。Sheet1をSheetsに変えた所、「実行エラー'1004':'Name'メソッドは失敗しました:'_Worksheet'オブジェクト」と出ました。

meg_

2021/08/10 07:32

「一覧」シートはアクティブブックに存在していますか？

kitagawas

2021/08/10 07:41

はい、「一覧」は現在表示しているExcelブックに存在しています。

kitagawas

2021/08/10 08:04

少し変えたりして上記のコードに戻すと「SubまたはFunctionが定義されていません。」というエラー文が出ました。

BeatStar

2021/08/10 08:32

前提の確認なんですけど、本当に「Excel」ですよね? OpenOfficeとかOpenLibreとかもあるようなので。

kitagawas

2021/08/10 08:44

はい、Excelです。

行動規範の内容に同意します

回答1件

ベストアンサー

知らんけど。

VBA
1Sub Excel一括保存()
2    Dim ws1 As Worksheet
3    Dim ws2 As Worksheet
4    Set ws1 = ThisWorkbook.Worksheets("一覧")
5    Set ws2 = ThisWorkbook.Worksheets("紹介")
6    
7    Dim wb As Workbook
8    Dim i
9    For i = 7 To ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row
10        ws2.Range("D2").Value = ws1.Range("C" & i).Value
11        ws2.Range("D4").Value = ws1.Range("D" & i).Value
12        ws2.Range("D7").Value = ws1.Range("E" & i).Value
13        ws2.Range("D10").Value = ws1.Range("F" & i).Value
14        ws2.Copy
15        Set wb = ActiveWorkbook
16        wb.SaveAs ws1.Range("E" & i).Value & "_" & ws1.Range("D" & i).Value
17        wb.Close False
18    Next
19    ws2.Range("D2:H12").ClearContents
20End Sub
21
22Sub PDF一括保存()
23    Dim ws1 As Worksheet
24    Dim ws2 As Worksheet
25    Set ws1 = ThisWorkbook.Worksheets("一覧")
26    Set ws2 = ThisWorkbook.Worksheets("紹介")
27    
28    Dim wb As Workbook
29    Dim i
30    For i = 7 To ws1.Range("B" & ws1.Rows.Count).End(xlUp).Row
31        ws2.Range("D2").Value = ws1.Range("C" & i).Value
32        ws2.Range("D4").Value = ws1.Range("D" & i).Value
33        ws2.Range("D7").Value = ws1.Range("E" & i).Value
34        ws2.Range("D10").Value = ws1.Range("F" & i).Value
35        ws2.ExportAsFixedFormat xlTypePDF, ws1.Range("E" & i).Value & "_" & ws1.Range("D" & i).Value
36    Next
37    ws2.Range("D2:H12").ClearContents
38End Sub

投稿2021/08/06 00:05

jinoji

総合スコア4585

kitagawas

2021/08/09 11:03

回答ありがとうございます。コンパイルをすると「実行時エラー'g':インデックスが有効範囲にありません。」と表示され 4行目：Set ws1 = ThisWorkbook.Worksheets("一覧") に→が表示されました。エラー文をそのまま検索して調べたのですが、意味があまり分かりませんでした。どうすれば解決できるのか教えていただけないでしょうか。