ExcelVBA SET Worksheetsで実行時エラー'438'が発生する理由について

このQ&Aのポイント
  • ExcelVBAのSET Worksheetsで実行時エラー'438'が発生する原因として、オブジェクトがこのプロパティまたはメソッドをサポートしていないためです。
  • 具体的な箇所は、Set Worksheets(シート名) = 現状保存の部分です。
  • このエラーが発生する理由は、シート名が存在しないか、正しく指定されていない可能性があります。
回答を見る
  • ベストアンサー

ExcelVBA SET Worksheets(

お世話になります 済みません お馬鹿質問だ とは、思うのですが お許し下さい 下記の、箇所で 実行時エラー '438': オブジェクトは、このプロパティまたはメソッドをサポートしていません に。なります 何故で、しょうか? 宜しく、お願いします。                記 Sub Main() Dim 現状保存 As Worksheet, シート名 As String Application.ScreenUpdating = False Set 現状保存 = Worksheets.Add() Set Ws = Worksheets.Add() Application.ScreenUpdating = True Let シート名 = ActiveSheet.Name Set 現状保存 = ActiveSheet ~~~中略~~~ Set Worksheets(シート名) = 現状保存 ← 此所です Application.DisplayAlerts = False 現状保存.Delete Ws.Delete Application.DisplayAlerts = True End Sub 以上

  • Nouble
  • お礼率91% (1698/1856)

質問者が選んだベストアンサー

  • ベストアンサー
回答No.5

> もっと、根本的に > Set Worksheets(シート名) = 現状保存 > が、エラーに、なる理由に、ついて触れて ますよ。 >> ご承知の通り、Setステートメントは >> 「オブジェクト変数に変数(オブジェクト)を代入・格納する」 及び >> 「左辺を右辺に即して代入」 A1セルに「1」を入力するとき、   1 = Range("A1") とは書きませんよね? あるいは、整数型変数「i」にA1セルの値を代入するとき、   Range("A1") = i とすると、iの値がA1セルに入ってしまいますよね? ご提示の > Set Worksheets(シート名) = 現状保存← 此所です における左辺「Worksheets(シート名)」は"オブジェクト変数"ですか? 私にはオブジェクト「そのもの」であり、変数ではないように見えます。 ※「WorkSheets()」を変数として扱える手段があるのだとしたら、  私の知識不足による誤解としてご容赦ください。

Nouble
質問者

お礼

有り難うございます やはり其処なのですね

その他の回答 (4)

回答No.4

> 走らせる、際は入れて、頂けて … …ますよね? 至極当然です。 と言いたいところですが、走らせていません。 > ~~~中略~~~ とされているのですから、走らせようがありませんもんね。 ついでに言うと、添付された画像も拡大していません。 なので、走らせずともわかる範囲として >> これを見る限りの回答 としています。 ご承知の通り、Setステートメントは 「オブジェクト変数に変数(オブジェクト)を代入・格納する」 ことを目的に使います。 Setステートメントを使うのであればVBAの常識である 「左辺を右辺に即して代入」に則って   Set オブジェクト変数 = 代入(格納)すべきオブジェクト とするのが一般的であり、質問中でご提示の通り、 > Dim 現状保存 As Worksheet, シート名 As String 「現状保存」をオブジェクト変数であると宣言していることを踏まえて、 わざわざ確認するまでもなく、先の回答 >> 逆ですよ。 >>   Set 現状保存 = Worksheets(シート名) につなげたわけです。 さて、言い訳はこのくらいにして、本題。 > 私の、意図と、しては作業開始時保存した、 > 内容への書き戻しに、よる傍若無人な、程の不測の、消去 添付図を拡大して見てみましたし、質問の文章を読み返しても見ましたが、 (補足以外の)どこにもこの情報は無いですよね? マクロを動かしたあとの「元に戻す」と受け取って良いのであれば、 コピーして貼り付ける   現状保存.Cells.Copy Worksheets(シート名).Cells だけで済むと思うのですが、いかがでしょうか? ・・・と、見落としていました。 というか、補足を読んで気づきました。 私の記憶では   Worksheets.Addしてやると、追加されたシートがアクティブになる だったと思うのですが・・・ > Set 現状保存 = Worksheets.Add() > Set Ws = Worksheets.Add() > (略) > Let シート名 = ActiveSheet.Name > Set 現状保存 = ActiveSheet この順番だと、オブジェクト変数「現状保存」には 追加された新規シートが格納されるような気がします。 文字列変数「シート名」にも新規シートの名前が格納されますね。 ・・・いや、違うな。 「現状保存」には、謎の変数「Ws」に格納された新規シートが、 「シート名」には、謎の変数「Ws」の名前が それぞれ格納されてしまいますね。 これで本当にいいのですか? 「Ws」が何なのかとりあえず無視し、 このマクロを走らせる時点で「元のシート」がアクティブだと信じて   Let シート名 = ActiveSheet.Name   ActiveSheet.Copy After:=Worksheets(Worksheets.Count)   Set 現状保存 = ActiveSheet   ' Set Ws = Worksheets.add  ' 無視 の順番にしてやらないと「元に戻す」機能を成さない気がします。

Nouble
質問者

お礼

有り難うございます 〉追加されたシートがアクティブになる あぁ!! 概念的に、見落として ました 有り難う御座います では、修正させてください Sub Main() Dim 現状保存 As Worksheet, シート名 As String Let シート名 = ActiveSheet.Name Application.ScreenUpdating = False Set 現状保存 = Worksheets.Add() Set Ws = Worksheets.Add() Application.ScreenUpdating = True Set 現状保存 = Worksheets(シート名) '~~~中略~~~ Set Worksheets(シート名) = 現状保存'← 此所です Application.DisplayAlerts = False 現状保存.Delete Ws.Delete Application.DisplayAlerts = True End Sub と、させてください 解り易い、ように もっと、短くすると Dim 現状保存 As Worksheet, シート名 As String Let シート名 = ActiveSheet.Name Set 現状保存 = Worksheets.Add() Set 現状保存 = Worksheets(シート名)'← 此処もかも? '~~~中略~~~  Set Worksheets(シート名) = 現状保存'← 此所です でも、此でも エラーに、なりませんか? もっと、根本的に Set Worksheets(シート名) = 現状保存 が、 エラーに、なる 理由に、ついて 触れて、頂けると 助かります 確かに、コピーでも いい かも、知れません が、 求めよ、さらば開かれん と、申します 求めを、辞めては いけない 正に、今 開かれよう と、する 世界も 閉ざした、まま に、なる と、 言う、意味 で、しょうか? 天使が 肩を、叩いて 新たな、扉の 向こうを、指差して 首根っこを、掴んで 引きずろう と、して 尚 肩を、うな垂れ ガックシ、している そんな、様が 見て取れそう、です 回避策も、良い の、ですが 是非、 何故、駄目か 知りたい の、です 宜しく お願い、します。

Nouble
質問者

補足

何と、なく ですが Worksheets("シート名")の ポインタアドレスが、変えられないんだな 仮に、出来た と、しても 重複名を、許してない ので Set処理の 一連の、中の 名前処理が、出来ないんだな と、思いました なので、仕様上 Set、出来ない のかな? 恐らく Dim 現状保存1 As Worksheet. 現状保存2 As Worksheet. Dim シート名 As String Let シート名 = ActiveSheet.name Set 現状保存2=現状保存1        ' 可 Set 現状保存1=ActiveSheet       ' 可 Set 現状保存1 = Worksheets(シート名) ' 可 Set Worksheets(シート名) = 現状保存1 '不可 Set ActiveSheet = 現状保存1      ' 可 ですかね? あと、例えば               ポインタ先 ActiveSheet             ← シート2 Set 現状保存 = Worksheets.ADD  ← シート22 Set 現状保存 = ActiveSheet     ← シート2 で、 保存に、なって ませんね Worksheet(シート名).copy After:=Worksheets.count Set 現状保存 = ActiveSheet とか、しないと 保存に、ならない かも? シート単位の、書き戻しは 依然、不明 所で cでは ポインタアドレスの、代入 の、他に 実体の、代入も 出来ました、よね? VBAでは、不可 ですか? と、此は 別スレッド、ですね 引き続き、ご解答を お待ち、しています て、いうか そろそろ 甘えすぎで 質問も、重ねて 来たし スレッド、変えた方が 良い、かな?

回答No.3

> Dim 現状保存 As Worksheet, シート名 As String >  (略) > Set Worksheets(シート名) = 現状保存← 此所です えーと・・変数の宣言は  「現状保存」 ⇒ ワークシート  「シート名」 ⇒ 文字列 ですもんね。 これを見る限りの回答をするとしたら・・ 逆ですよ。   Set 現状保存 = Worksheets(シート名)

Nouble
質問者

お礼

有り難うございます 〉逆ですよ。 私の、意図 と、しては 作業開始時 保存した、内容への 書き戻しに、よる 傍若無人な、程の 不測の、消去 ですので データ、移動方向は 合って、いる と、思われる の、ですが 仕様上の、問題 とか で、しょうか? 何等かを、お預かりした 者 と、して 対象の、価値に ついて 疑わず、触れず、 例え、コピー で 未だ、大量に 作成できる、もの で、あろうと 唯一無二の、マスター と、して 扱う 此が 何かを、預かる 其の、際の 根底、根源、 足る、 信頼に、購う 行為 と 思って、います ので 基本と、弁えている 次第、です 是非、 実現、したい の、ですが 難しい で、しょうか?

Nouble
質問者

補足

〉〉Set Worksheets(シート名) = 現状保存← 此所です 注釈に「'」を 入れて、ない の、ですが 走らせる、際は 入れて、頂けて … … ますよね?

  • mdmp2
  • ベストアンサー率55% (438/787)
回答No.2

No.1 です。 さきほどは全体を読まずに回答してしまいました。すみません。 ・~~~中略~~~の部分を削除して、実行してみました。たしかにその場所でエラーになります。ただ、中略の中に「現状保存」を操作する記述があると、中略の部分を除いて実行した結果がエラーになったとしても、もともとのコード実行のエラーとは違う理由かもしれません。さしつかえなければ中略の部分を補足したほうが良いのでは? ・Set Worksheets(シート名) = 現状保存 でどのような操作をするつもりなのでしょうか? ヘルプを見ると、Worksheets(シート名)は値の取得のみ可能となっています。一方、このコードの Set のに続く部分が、Worksheets(xx)=Worksheets(yy)の形になっていて、値の取得だけではないのが問題なのではないでしょうか?

Nouble
質問者

お礼

有り難うございます 責任の、観点から VBA、動作中の 不測の、動作や、 不測の、人為介入を、 キャンセル、する ため コントロールを 渡された、瞬間の Worksheet状態を 新規作成した、Worksheetに 退避して、おいて 作業、終わりに 復元する、意図 です 此の、観点から 言えば 現状保存Worksheetは 隠蔽し、保護する もしくは、更に 本来の、対象は Sheet、 では、なく ブック丸ごと、 の、方が 本道 で、しょうが 今回は 其処まで、して いません ご理解 頂けますで、しょうか?

  • mdmp2
  • ベストアンサー率55% (438/787)
回答No.1

Set Worksheets(シート名) = 現状保存 "現状保存" としてみては、

Nouble
質問者

お礼

早々のご対応 痛み入ります

関連するQ&A

  • EXCEL2011 Objectに入れたWork…

    お世話になります。 どうも よく、解らない の、ですが 下記で コメントアウト、させている ラインの、内 *印を、付けている どの行、をも コメントアウトから、戻すと ☆で、添付映像の エラーに、なります コメントアウトの、ままだと エラーには、なりません 察するに Wsが ActiveSheetで、無いと with Ws に、対する .Range(cells(… が、嫌っぽい の、ですが こんな事、当たり前 なのか 疑問、なのです お教え下さい。     記 Option Explicit Option Base 0 Dim Data(100, 100) As Long, Ch As Long, s1 As Long, s2 As Long, Ws As Worksheet, すとり As Range Sub testMain() ' 簡易テスト Dim 現状保存 As Worksheet, シート名 As String  Let シート名 = ActiveSheet.Name Application.ScreenUpdating = False  Worksheets(シート名).Copy after:=Worksheets(Worksheets.Count)  '■  Set 現状保存 = ActiveSheet                            '■  Set Ws = Worksheets.Add() ' Worksheets(シート名).Copy after:=Worksheets(Worksheets.Count)  '*□ ' Set 現状保存 = ActiveSheet                      ’□ ' Worksheets(シート名).Select                    '*  現状保存.Visible = False ' Ws.Visible = False                       '* Application.ScreenUpdating = True  Call ダミーデータ作成  Call testC  Call testV  Call testE Application.DisplayAlerts = False 現状保存.Delete Ws.Delete Application.DisplayAlerts = True End Sub Sub ダミーデータ作成()  With Ws.Range("a1:cv100")   .Formula = "=RANDBETWEEN(1,10000)"   .Calculate   .Value = .Value  End With  Let Ws.Cells(1, 101).Formula = "=MIN(" & Ws.Name & "!" & Ws.Range("a1:cv100").Address & ")"  Ws.Cells(1, 101).Calculate  For s2 = 1 To 100   For s1 = 1 To 100    Data(s1, s2) = Ws.Cells(s1, s2).Value   Next s1  Next s2  Let Data(0, 0) = Ws.Cells(1, 101).Value End Sub Sub testC()  Ch = 10000  With Ws   For s2 = 1 To 100    For s1 = 1 To 100     If Ch > .Cells(s1, s2).Value Then Ch = .Cells(s1, s2).Value    Next   Next  End With End Sub Sub testV()  Ch = 10000   For s2 = 1 To 100    For s1 = 1 To 100     If Ch > Data(s1, s2) Then Ch = Data(s1, s2)    Next   Next End Sub Sub testE()  With Ws   すとり = .Range(Cells(1, 1))                 '☆  End With End Sub (※注:□の2行を コメントから 外す、時は  同、■の2行を コメントアウトして、下さい)                       以上

  • EXCEL2011 Objectに入れたWor…改

    お世話になります。 どうも なんと言って 良いのか 本当に、済みません スレットを、変えよう と、して 念の、ため 確認に、再度 走らせて、みた の、ですが コメントアウト、させていても ☆で、添付映像の エラーに、なります もう頭が ?????? です 兎に角 エラー理由が、解りません 申し訳、ありませんが お教え下さい。     記 Option Explicit Option Base 0 Dim Data(100, 100) As Long, Ch As Long, s1 As Long, s2 As Long, Ws As Worksheet, ランゲ As Range Sub testMain() ' 簡易テスト Dim 現状保存 As Worksheet, シート名 As String  Let シート名 = ActiveSheet.Name Application.ScreenUpdating = False  Worksheets(シート名).Copy after:=Worksheets(Worksheets.Count)  '■  Set 現状保存 = ActiveSheet                            '■  Set Ws = Worksheets.Add() ' Worksheets(シート名).Copy after:=Worksheets(Worksheets.Count)  '*□ ' Set 現状保存 = ActiveSheet                      ’□ ' Worksheets(シート名).Select                    '*  現状保存.Visible = False ' Ws.Visible = False                       '* Application.ScreenUpdating = True  Call ダミーデータ作成  Call testC  Call testV  Call testE Application.DisplayAlerts = False 現状保存.Delete Ws.Delete Application.DisplayAlerts = True End Sub Sub ダミーデータ作成()  With Ws.Range("a1:cv100")   .Formula = "=RANDBETWEEN(1,10000)"   .Calculate   .Value = .Value  End With  Let Ws.Cells(1, 101).Formula = "=MIN(" & Ws.Name & "!" & Ws.Range("a1:cv100").Address & ")"  Ws.Cells(1, 101).Calculate  For s2 = 1 To 100   For s1 = 1 To 100    Data(s1, s2) = Ws.Cells(s1, s2).Value   Next s1  Next s2  Let Data(0, 0) = Ws.Cells(1, 101).Value End Sub Sub testC()  Ch = 10000  With Ws   For s2 = 1 To 100    For s1 = 1 To 100     If Ch > .Cells(s1, s2).Value Then Ch = .Cells(s1, s2).Value    Next   Next  End With End Sub Sub testV()  Ch = 10000   For s2 = 1 To 100    For s1 = 1 To 100     If Ch > Data(s1, s2) Then Ch = Data(s1, s2)    Next   Next End Sub Sub testE()  With Ws   Set ランゲ = .Range(Cells(1, 1))               '☆  End With End Sub (※注:□の2行を コメントから 外す、時は  同、■の2行を コメントアウトして、下さい)                       以上

  • VBA 同じ場所に保存する

    部署ごとに分割し、ブックで保存するコードです。 保存場所がデスクトップになっています。 これを同じ場所に保存する方法をお知らせください。 よろしくお願いします。 Sub macro1() Dim w As Worksheet Dim n As Long Dim r As Long Dim s As String Dim WSH As Variant Dim myPath As String Set w = ActiveSheet n = Worksheets.Count Application.ScreenUpdating = False On Error GoTo errhandle For r = 2 To w.Range("A65536").End(xlUp).Row s = w.Cells(r, "A") w.Rows(r).Copy Worksheets(s).Range("A65536").End(xlUp).Offset(1) Next r On Error GoTo 0 Set WSH = CreateObject("Wscript.Shell") myPath = WSH.specialfolders("Desktop") & "\" For r = Worksheets.Count To n + 1 Step -1 Worksheets(Worksheets.Count).Copy ActiveSheet.Columns.AutoFit ActiveWorkbook.SaveAs Filename:=myPath & ActiveSheet.Name ActiveWorkbook.Close False Application.DisplayAlerts = False Worksheets(Worksheets.Count).Delete Application.DisplayAlerts = True Next r w.Select Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = s w.Rows(1).Copy Range("A1") Resume Application.ScreenUpdating = True End Sub

  • Excelマクロについての質問です。

    Excelのマクロについての質問です。 マクロについての質問です。 以下のようなマクロを作成しました。 このマクロを動作させているのはこのマクロを作成したファイル上です。 Sub Macro9() Dim WBA As Workbook Dim WBB As Workbook Dim WSA As Worksheet Dim WSB As Worksheet Set WBA = Workbooks("A") Set WBB = Workbooks("B") Set WSB = WBB.Worksheets("1") For i = 100 To 3000 Step 20 Worksheets.Add Before:=Worksheets("Sheet1") Dim k As String k = i ActiveSheet.Name = (k / 100) Set WSA = WBA.Worksheets(k / 100) WSB.Range("A1:AY30").Copy Destination:=WSA.Range("A1") WSA.Range("D4:I30").Clear WSA.Range("Q4:V30").Clear WSA.Range("AD4:AI30").Clear WSA.Range("AQ4:AV30").Clear Next i Application.DisplayAlerts = False Sheets("Sheet1").Delete Application.DisplayAlerts = True Application.DisplayAlerts = False Sheets("Sheet2").Delete Application.DisplayAlerts = True Application.DisplayAlerts = False Sheets("Sheet3").Delete Application.DisplayAlerts = True End Sub そこで質問ですが、このマクロを作動させると何のエラーの表示もなく最後まで動作は完了します。 ですが、シートの作成は30まで作成できてもその後のセルのコピー&ペーストはなぜかシート6.8までしかできていません(7~30までのシートはシート作成はできているのですがコピペのみが実行されず空白のままになっています。) シートもコピペも両方ともシート30まで完了するにはどの点を改善すればいいのでしょうか? 知恵が足りずどうしても直す事が出来ません。 長文申し訳ございませんが是非皆さまのお知恵をお貸しください。 宜しくお願い致します。

  • worksheetsの名前変更マクロ

    マクロでsheetsをコピーしてそのあと名前を変更するマクロを作っているのですがうまくいきません。 マクロで他のbookを開いて、そのbook名をsheets名にしたいのですが以下のマクロではうまくいきませんでした。どこが悪いのでしょうか? ご指導お願いいたします。 Sub ~() OpenFileName = Application.GetOpenFilename("TXT/CSVファイル,*.txt?;*.csv?") ThisWorkbook.Activate Application.ScreenUpdating = False If OpenFileName <> "False" Then Set TargetBook = Workbooks.Open(OpenFileName) ThisWorkbook.Activate Worksheets("マクロ用名称変更不可").Copy before:=Worksheets("マクロ用名称変更不可") ActiveSheet.Name = OpenFileName TargetBook.Close Application.ScreenUpdating = True Else MsgBox "キャンセルしました" End If End Sub

  • VBA シート指定とファイル名入力

    部署ごとに分割し、ブックで保存するコードです。 sheet名は「部署」です。 Sub macro1() Dim w As Worksheet Dim n As Long Dim r As Long Dim s As String Dim WSH As Variant Dim myPath As String Set w = ActiveSheet n = Worksheets.Count Application.ScreenUpdating = False On Error GoTo errhandle For r = 5 To w.Range("B65536").End(xlUp).Row s = w.Cells(r, "B") w.Rows(r).Copy Worksheets(s).Range("B65536").End(xlUp).Offset(1, -1) Next r On Error GoTo 0 Set WSH = CreateObject("Wscript.Shell") myPath = ActiveWorkbook.Path & "\1\" For r = Worksheets.Count To n + 1 Step -1 Worksheets(Worksheets.Count).Copy ActiveSheet.Columns.AutoFit ActiveWorkbook.SaveAs Filename:=myPath & ActiveSheet.Name ActiveWorkbook.Close False Application.DisplayAlerts = False Worksheets(Worksheets.Count).Delete Application.DisplayAlerts = True Next r w.Select Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = s w.Rows(1).Copy Range("A1") w.Rows(2).Copy Range("A2") w.Rows(3).Copy Range("A3") w.Rows(4).Copy Range("A4") Resume Application.ScreenUpdating = True End Sub (1)sheet1にマクロ実行ボタンを配置し、部署seedにマクロ実行命令をする。 (2)sheet1のB2セルにファイル名を入力して、そのファイルに保存する。(例部署ファイル) (1)Dim w As Worksheets("部署")と変更したのですが、エラーが出ました。 (2)myPath = ActiveWorkbook.Path & "\部署ファイル\"   ↑ これをsheet1のB2セルから指定できるようにしたいです。 宜しくお願いします。

  • エクセル:マクロの手直し

    お世話になります。 以前ここで教えてもらったマクロのシート名のつけ方をすこし手直ししたいのでアドバイスください。 以下のマクロは、1シート目を決まった行数分に分割し各シートに振り分けるものです。今のマクロではシート名は分割1、分割2…分割10…などなりますが、Worksheets(1) のシート名+3桁の連番(001,002…010…)などとしたい。 Worksheets(1) のシート名が「総務課」の場合、総務課001,総務課002…総務課010…となるのが理想です。 このようにするためにはマクロをどのように修正すればよいか教えてください。 Sub シート分割()  Dim WS1 As Worksheet  Dim WS2 As Worksheet  Dim i As Integer  Dim Bunkatsu As Integer  Set WS1 = Worksheets(1) 'コピー元のデータシート  Set WS2 = WS1  Bunkatsu = 1  Application.ScreenUpdating = False  For i = 7 To WS1.Cells(Rows.Count, 1).End(xlUp).Row Step 25   Set WS2 = Worksheets.Add(After:=WS2)   WS2.Name = "分割" & Bunkatsu   WS1.Rows("1:6").Copy WS2.Cells(1, 1)   WS1.Rows(i & ":" & i + 24).Copy WS2.Cells(7, 1)   Bunkatsu = Bunkatsu + 1  Next  Application.ScreenUpdating = True End Sub

  • インプットボックスについて

    指定したシートを削除するマクロを作っています。1つのシートを指定して削除するマクロはできたのですが、複数のシートを指定して削除するにはどうすればいいか分からなくて困っています。教えて下さい。 Sub 指定して削除() Application.DisplayAlerts = False Sheet = InputBox("削除したいシート名を入力して下さい。") Worksheets(Sheet).Delete Application.DisplayAlerts = True End Sub

  • 部署ごとに分割し、ブックで保存するコード

    部署ごとに分割し、ブックで保存するコードです。 A1、1列目から分割していますが、B2、4列目から分割する方法を教えてください。 A65536をB65536に変えたりなどしていましたが、エラーが出ます。 よろしくお願いします。 Sub macro1() Dim w As Worksheet Dim n As Long Dim r As Long Dim s As String Dim WSH As Variant Dim myPath As String Set w = ActiveSheet n = Worksheets.Count Application.ScreenUpdating = False On Error GoTo errhandle For r = 2 To w.Range("A65536").End(xlUp).Row s = w.Cells(r, "A") w.Rows(r).Copy Worksheets(s).Range("A65536").End(xlUp).Offset(1) Next r On Error GoTo 0 Set WSH = CreateObject("Wscript.Shell") myPath = ThisWorkbook.Path & "\" For r = Worksheets.Count To n + 1 Step -1 Worksheets(Worksheets.Count).Copy ActiveSheet.Columns.AutoFit ActiveWorkbook.SaveAs Filename:=myPath & ActiveSheet.Name ActiveWorkbook.Close False Application.DisplayAlerts = False Worksheets(Worksheets.Count).Delete Application.DisplayAlerts = True Next r w.Select Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = s w.Rows(1).Copy Range("A1") Resume Application.ScreenUpdating = True End Sub

  • ExcelVBA シートコピー

    ExcelVBAで管理表1のシート1へ管理表2のシート2へコピーするVBAを書いてみました。 以下部分を修正したいです。 wbSaki.Worksheets("シート2").Range("A1:VA3000").Copy こちらの選択範囲を最終行と最終列という風にしたいのですが、うまくコピー貼り付けができないので理由がわかる方がいらっしゃれば教えていただけますでしょうか。 以下全体コード------------------ Sub 管理表1のシート1を管理表2のシート2へを貼り付け() '選択したファイルを取り込み、別のファイルに貼り付ける。 Dim RC As Integer Dim OpenFileName, fileName, Path, SetFile As String Dim wbMoto, wbSaki As Workbook Set wbMoto = ThisWorkbook 'マスターデータ取り込み元をセット Application.DisplayAlerts = False Application.ScreenUpdating = False 'BOOKを開かない RC = MsgBox("管理表1を開きますか?", vbYesNo + vbQuestion, "確認") If RC = vbYes Then 'サーバー指定 End Withまで With CreateObject("WScript.Shell") strCdir = CurDir .currentdirectory = "ファイル格納先" OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") 'ダイアログボックスを表示して、マスターデータファイルを指定します。 If OpenFileName <> "False" Then SetFile = OpenFileName Else MsgBox "キャンセルされました" Exit Sub 'マスターデータの取り込みをキャンセル End If End With Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 'ダイアログボックスで指定したマスターデータファイルを開きます。 'VBA起動BOOKのシートをクリア wbMoto.Worksheets("シート1").Cells.Clear Set wbSaki = Workbooks.Open(Path & SetFile) '--- オートフィルタをクリアする ---' If wbSaki.Worksheets("シート2").FilterMode Then wbSaki.Worksheets("シート2").ShowAllData 'ワークブック間のシートをコピーします。 wbSaki.Worksheets("シート2").Range("A1:VA3000").Copy wbMoto.Worksheets("シート1").Range("A1").PasteSpecial xlPasteValues Application.CutCopyMode = False 'コピー切り取りを解除 wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる Application.ScreenUpdating = True 'BOOKを開かずに作業 Else MsgBox "処理を中断します" End If ThisWorkbook.Worksheets("元のシート").Select 'シート名を指定 Application.DisplayAlerts = True End Sub

専門家に質問してみよう