ExcelVBAにシートに名をつけて保存のさせたい

このQ&Aのポイント
  • VBAを使用してExcelシートに名前をつけて保存する方法について教えてください
  • 自分で作成したVBAではシートに名前をつけて保存することができません。エラーが発生します。
  • 具体的なVBAコードを提示し、どこが間違っているのか確認していただきたいです。
回答を見る
  • ベストアンサー

ExcelVBAにシートに名をつけて保存のさせたい

現在、VBA勉強中の初心者です。 自分なりに作成したVBAではうまく作動しません。 どなたか教えてください。 sheet1(受付簿)のデータをB3~U43までコピーして、名前をつけて新たに別シートに作成保存し、作成したシートのA1に、値と書式を貼り付けます。 そして作成したシートを、一番右側に作成したいのですが、エラーが発生します。 (エラー) 「実行時のエラー オブジェクトは、このプロパティまたはメソッドをサポートしていません」 が発生します。 下記のように、VBAを作成したのですが、どこが間違いなのかご指摘をお願いします。 Sub 別シートに名前をつけて保存() Dim title As String Dim msg As String Dim t As String title = " 別シートに名前をつけて保存する" msg = "名前を入力してください" t = InputBox(msg, title) Worksheets("受付簿").Range("B1:U43").Copy With Worksheets.Add .Name = t .Range("a1").Select .Range("a1").Paste .Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End With Application.CutCopyMode = False End Sub お忙しい中、申し訳ありませんが、どうぞよろしくお願いします。

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

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.3

>シートに名前をつけて保存した後、VBEを見たらマクロまで一緒にコピーされております。 一般論として,ブックにマクロを登録するときには 1.ALT+F11でVBE画面を開く 2.マクロを付けたいブックのVBAProjectに(通常は何もしなくてもそうなっていますが)   VBE画面の挿入メニューから標準モジュールを追加する 3.挿入した標準モジュールにふつーのマクロを記述する 4.Excel画面に戻って登録したマクロを実行する のように作成します。 追加ご質問の意図は,例えば「シート名タブを右クリックしてコードの表示を選んで表示されたシートに回答マクロを記入して動かしてます」といった状況だということでしょうか。 シートモジュールには回答したような一般的なマクロじゃなく,シートのイベントプロシジャだとかコントロールツールボックス用のコマンドボタンクリックのマクロだといった,特殊な用途のマクロを記述するために使います。 ご質問で作成中のものや既に寄せられている回答のようなマクロを使いたいときは,シートモジュールに記入したマクロは削除して(結果してシートはクリーンになります)上述手順で標準モジュールにマクロを書き改めてください。

eria888
質問者

お礼

keithin 様  myRange様 本日は本当にありがとうございました。 おかげさまで、100%自分がイメージしたものが出来上がりました。 またシートモジュールと標準モジュールの区別も一緒に教えてもらい、大変参考になり ました。 今まで、自分なりに勉強してきて、これは使えそうかな・・と思ったものを、コピーして 貼り付けたりして、マクロを作成してきたのですが、今回のように検索しても自分が思う ようなマクロを書いてあるページなど無く(あたりまえですが)、まったくもって応用が 利かないと実感しました。 やはりマクロは体型的に勉強するべきだな・・・と改めて反省いたしまいした。 長くなりましたが、本日は本当にありがとうございました。 感謝!!!

その他の回答 (3)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.4

エラーが出る行も参考のため、質問に書いておくものだ。 >名前をつけて新たに別シートに作成保存し この表現は紛らわしい 「名前をつけて新たに別シートに作成し」で良いだろう。最後にこのBookを保存するとしても、質問事項では無いだろう。 質問のコードにも無い。 >一番右側に作成したいのですが このコードは質問のコードには無いのでは。 ActiveSheet.Move after:=Sheets(Sheets.Count) Sheet1にしたのは、回答者がテストデータを作りやすいからだ。ここまで気を使ってくれればありがたいが。 データ例を特徴の在る部分を十行程度書いてくれるとテストにはありがたいが。 ーー コード 下記でどうかな。 Sub 別シートに名前をつけて保存() Dim title As String Dim msg As String Dim t As String title = " 別シートに名前をつけて保存する" msg = "名前を入力してください" 't = InputBox(msg, title) t = "aaa" 'Worksheets("受付簿").Range("B1:U43").Copy Worksheets("sheet1").Range("B1:D15").Copy Worksheets.Add.Name = t ActiveSheet.Range("B1").Select ActiveSheet.Paste '.Range("a1").Paste '.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ ':=False, Transpose:=False '.Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, 'SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Move after:=Sheets(Sheets.Count) End Sub もうエラーが起こる議論の余地が無いコードの部分は、コメント化してt = "aaa" のようにしてテスト・デバッグ対象から省くことをお奨めする。 ーー コピーについて セル範囲のコピー貼り付け、 シート全体をシートへのコピー貼り付け のVBAは十分勉強してから使うこと。初心者には難しい点だ。怖さを知らないね。 今後、出来ればセル範囲の値の代入だけで出来るだけ済ますことをお奨めする。 またDestinationを活用すると良い。 >値と書式を貼り付けます。 これ以外のセルの属性は移ると困るのために、こんな思わせぶりな表現になっているのか。 コピー貼り付けではダメなのか。意識しているなら、理由を明示のこと。 ーー 以下はGoogleででも照会すれば記事がたくさんある事項だ。これらを調べましたか。 シート名の重複チェックは、上記コードには加えてないが http://gogo-blog.jugem.jp/?eid=22 を読んで勉強のこと。1発(1行)でチェックすすコードは無いようだ。VBSなどBook名ではFileExistsが使えるものもあるが、Sheet名には無い。 ーー 上記テストデータには、セル結合を含めてテストした。大丈夫のようだ。 セル結合のあるシートの扱いにくさは http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_030_200.html など参考に ーーー シートの一番右に http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_sheet.html の「シートを追加する」 参照

eria888
質問者

お礼

imogasi 様 ご回答ありがとうございました。 マクロ初心者とはいえ、質問の仕方が悪いところが多々あり、ご迷惑をおかけいたしま した。 今後は、教えていただいたサイトも参考にさせていただき、勉強していきたいと思います。 お忙しい中、回答を頂きありがとうございました。

  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.2

Sub Sample1()  Dim title As String  Dim msg As String  Dim t As Variant  title = " 別シートに名前をつけて保存する"  msg = "名前を入力してください"  t = InputBox(msg, title)  Worksheets("受付簿").Copy after:=Worksheets(Worksheets.Count) '最後に  With ActiveSheet   .UsedRange.Value = .UsedRange.Value   .Range("A:A").Delete shift:=xlShiftToLeft   On Error GoTo Errhandle   .Name = t   On Error GoTo 0  End With  Exit Sub Errhandle:  msg = "指定のシート名 '" & t & "' は使えません。再入力"  t = InputBox(msg, title)  If t = "" Then Exit Sub  Resume End Sub #上手く行かない困っている状況を詳しく話して貰うことも勿論必要ですが,それを具体的にどのような姿に解消したいのかについても補足が必要です。

eria888
質問者

お礼

回答者:keithin 様 回答誠にありがとうございます。 >>#上手く行かない困っている状況を詳しく話して貰うことも勿論必要ですが,それを 具体的にどのような姿に解消したいのかについても補足が必要です。 すみません。うまく説明出来なくて、回答者:myRange 様まかせで再質問して おりました。 keithin 様作成のVBAが自分が求めていた一番の理想の形ですが、一つ気になる点が あります。 シートに名前をつけて保存した後、VBEを見たらマクロまで一緒にコピーされております。 このままでも、特に支障は無いと思うのですが、シートが最大で70になる可能性 があるので、要領が大きくなりすぎしてしまうような気がします。 可能であれば、データ(書式を含む)だけをシートに保存出来ないでしょうか?

  • myRange
  • ベストアンサー率71% (339/472)
回答No.1

>ExcelVBAにシートに名をつけて保存のさせたい この"保存"は、ブックの保存ではないですよね?? 提示のコードには、それがないので。 で、提示のコードを修正すると。。。 '--------------------------------- Sub 別シートに名前をつけて保存()  Dim title As String  Dim msg As String  Dim t As String  title = " 別シートに名前をつけて保存する"  msg = "名前を入力してください"  t = InputBox(msg, title)  If t = "" Then Exit Sub  With Worksheets.Add(after:=Sheets(Sheets.Count))     .Name = t     Worksheets("受付簿").Range("B1:U43").Copy .Range("A1")  End With '▼保存するとき▼ ThisWorkbook.Save True End Sub '------------------------------------------------ 実務でやる場合は、入力したシート名が既に存在する場合のエラー処理コードが必要でしょう。 以上です。  

eria888
質問者

お礼

回答者:myRange 様 ご回答誠にありがとうございます。 >>この"保存"は、ブックの保存ではないですよね?? はい、myRange 様が作成していただいた、VBAを実行したかったのです。 ただ、ご指摘の点を含めて2点ほど再度質問させてください。 1 Worksheets("受付簿")には、セルで結合されたものなどがあり、そのまま新しいシート   に貼り付けると、新しく作成されたシートには、書式などがまったく異なります。    2 >>実務でやる場合は、入力したシート名が既に存在する場合のエラー処理コードが必   要でしょう。  まったくもってその通りです。いざ、同じ名前で実行したら・・・ 以上、2点の問題点があります。大変、勝手なのですが、対処方法を教えてくださいませんでしょうか?

関連するQ&A

  • エクセルマクロ 繰り返して、別のシートへコピーしたい

    エクセルマクロ 繰り返して、別のシートへコピーしたい マクロ初心者のため、やり方が全くわかりません。 どなたか教えてください。 やりたいことは、 コピーするシートはあらかじめ作成しています。 簡素化の方法がわからないので、 とりあえず自分で作ってみたものが下にあるものです。 繰り返す方法がわからないので、 どなたか教えてください。 よろしくお願いします。 以下、作成したマクロです。 1行目から10行目まで繰り返したくて、 1行目から2行目のセルの移動の差は10行目までかわりません。 '1行目 Sheets("Sheet1").Select Range("B14:C14").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B15:C17").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False '2行目 Sheets("Sheet1").Select Range("B18:C18").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B19:C21").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B2").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False

  • マクロについて教えてください

    マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの(氏名や項目は違いますが)を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1(A9) → sheet2(C2) sheet1(E9) → sheet2(C5) sheet1(I9) → sheet2(C8) ●項目1 sheet1(A8) → sheet2(E3) sheet1(E8) → sheet2(E6) sheet1(I8) → sheet2(E9) ●項目2 sheet1(A18~D18の結合セル) → sheet2(E2) sheet1(E18~H18の結合セル) → sheet2(E5) sheet1(I18~L18の結合セル) → sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか?? ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • 複数シートの一定範囲を、他シートの表に貼り付けたい

    Win7 Excel2007 でマクロ作成中の初心者です。 複数シートの一定の範囲を、総括表シートの中にある表に貼り付けたいです。 いろいろサイト探しましたが方法がわかりません。どうかご教示おねがいします。 Sub 総括表シートに貼り付け() ' Dim list, sheetName Application.ScreenUpdating = False Const EXCEPT_NAME = "総括表 保管用" For Each sheetName In ActiveWorkbook.Worksheets If InStr(EXCEPT_NAME, sheetName.Name) = 0 Then Sheets(sheetName.Name).Activate ActiveSheet.Unprotect   複貼り付け用部品 ActiveSheet.Protect End If Next End Sub -------------------------------------------- Sub 複貼り付け用部品() ’自動記録のコード 'すべてのシートの Range("AW7:AW34")の範囲を総括表シートに貼り付け '貼り付け位置は、総括表のシートのD列からに順番に貼り付け ActiveSheet.Unprotect Range("AW7:AW34").Select '最初のシート Selection.Copy Range("D4:D31").Select '総括表シートのD列に貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AW7:AW34").Select '2番目のシート Application.CutCopyMode = False Selection.Copy Range("E4:E31").Select '総括表シートのE列に貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AW7:AW34").Select '3番目のシート Application.CutCopyMode = False Selection.Copy Range("F4:F31").Select '総括表シートのF列に貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AW7:AW34").Select '4番目のシート Application.CutCopyMode = False Selection.Copy Range("G4:G31").Select '総括表シートのG列に貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '以下続く End Sub

  • 複数のシートを別ブックにコピーして保存したい

    毎回、シート数が変動するEXCELファイルの、表示されているシートのみ(非表示シート有)を、 別のブックにコピーして、セルの書式と値を貼付けし、 元ファイルのシート名と同じシート名を付けたいのですが、 どんなVBAを組めば良いでしょうか? 下記の様に作成してみましたが、ファイル自体がコピペされてしまう様で、 自分のイメージした通りに動きません・・・。 ご教授の程、宜しくお願いいたします。 Sub データ書き出し() Dim ws As Worksheet Dim i As Long With ActiveWorkbook i = Worksheets.Count For j = 1 To i ThisWorkbook.Worksheets(j).Cells.Copy .Worksheets(j).Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Next j Application.CutCopyMode = False .SaveAs "月別DATA_" End With End Sub

  • Excelでマクロを繰り返したい。

    Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件= Field:は4~35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。

  • 形式を選択して貼り付け

    Range("a" + z + 1).PasteSpecial_ Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True 上記を入力し、実行すると「この操作には同じサイズの結合が必要です」とエラーが出ます。本を見て同じように作成したので、何処が間違ってるのか、分かりません。教えて下さい。

  • 指定セルをコピー

    A2~A5,D2~D5,G2~G5をコピーしJ~P列2~5行に値を貼付け続いて9~13行、16~20行もJ~P列に貼り付けたいのですが7~8,14~15行にはセル結合されているところもあります。VBAで下記コードを入力しましたがあまりにデータが多く何か良い方法VBAコードはありますか。(For~Nextなど使用すれば良いのでしょうか) 環境はoffice2013です。 Range("A2:A6").Select Selection.Copy Range("J2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D2:D6").Select Selection.Copy Range("M2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False  Application.CutCopyMode = False

  • エクセルで、シートを非表示のままマクロを実行するには?

    エクセル初心者です。 Sheet1で、マクロの実行ボタンがあり、Sheet2で、データを編集して、 Sheet1に結果の一覧を表示させるマクロなのですが、 Sheet2は非表示のままマクロを実行したいのですが、うまくいかず、 Sheet2を表示して、実行するとうまくいくため、 一時的にシートを表示させるようにしてみたのですが、 Sheets("Sheet2").Range(Cells(2, 28), Cells(rowCnt, 37)).Insert Shift:=xlDown で、アプリケーション定義・オブジェクト定義エラーになります。 どなたかご指南下さい。 Private Sub EDITSLINF() Dim rowCnt As Long Application.ScreenUpdating = False Worksheets("製造記録一覧 (edit1)").Visible = True  Sheets("Sheet2").Range("AB2:AK300").ClearContents '追加レコード抽出&コピー&ペースト Sheets("Sheet2").Range("Q1:Z300").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "AP1:AP2"), CopyToRange:=Sheets("Sheet2").Range("AB1:AK1"), Unique:=False '既存レコードコピー&ペースト rowCnt = Sheets("Sheet2").Range("O1") Sheets("Sheet2").Range(Cells(2, 28), Cells(rowCnt, 37)).Insert Shift:=xlDown Sheets("Sheet2").Range(Cells(2, 28), Cells(rowCnt, 37)).Interior.ColorIndex = xlNone Sheets("Sheet2").Range(Cells(2, 2), Cells(rowCnt, 11)).Copy Sheets("Sheet2").Range("AB2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Worksheets("Sheet2").Visible = False 'メインシートへコピー   Application.CutCopyMode = False Sheets("Sheet2").Range("AB2:AJ300").Copy Sheets("Sheet1").Range("K4").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False End Sub

  • エクセルで複数ファイルからコピーをする。

    すみませんが、BOOK1に複数のファイルから部分的にコピーして貼り付けるという作業をしたいのですが、ど素人なもんでわかりません。マクロで記録したモノをいじってみてるのですが、根本的にコードが分かっていなくギブアップです。  やりたいことは、フォルダーの中の970305日報1、970305日報2、970306日報1、970306日報2のようなファイルが山ほどあるのですが、 この970305の日報1と2を開き、それぞれファイルの決まった列を順番にをBook1の行へ行列を入れ替えて貼りつけていき(1日が1行)保存して閉じてから、次の日970306のデータをBOOK1の2行目に貼り付けるということをしたいのですが、どなたか教えていただければ助かります。よろしくお願いします。 Sub Macro2() Dim MyFile As String, MyPath As String Dim wb As Workbook, tb As Workbook Set tb = ThisWorkbook MyPath = tb.Path & "\" MyFile = Dir(MyPath & "*.xls", vbNormal) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Do While MyFile <> "" If MyFile <> tb.Name Then Set wb = Workbooks.Open(MyPath & MyFile) With ActiveSheet Windows("970305日報1.xls").Activate Range("B34:B38").Select Application.CutCopyMode = False Selection.Copy Windows("日報リスト.xls").Activate Range("C1").Select Selection.PasteSpecial Paste:=xlPasteAll,         Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Windows("970305日報1.xls").Activate Range("C33:C38").Select Application.CutCopyMode = False Selection.Copy Windows("日報リスト.xls").Activate Range("H1").Select Selection.PasteSpecial Paste:=xlPasteAll,       Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False ActiveWorkbook.Save Windows("970305日報1.xls").Activate ActiveWindow.Close Windows("970305日報2.xls").Activate Range("B31:B36").Select Selection.Copy Windows("日報リスト.xls").Activate Range("N1").Select Selection.PasteSpecial Paste:=xlPasteAll,   Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Windows("970305日報2.xls").Activate Range("D31:D36").Select Application.CutCopyMode = False Selection.Copy Windows("日報リスト.xls").Activate Range("T1").Select Selection.PasteSpecial Paste:=xlPasteAll,   Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False ActiveWorkbook.Save Windows("970305日報2.xls").Activate ActiveWindow.Close Windows("970306日報1.xls").Activate Range("B34:B38").Select Application.CutCopyMode = False Selection.Copy Windows("日報リスト.xls").Activate Range("C2").Select Selection.PasteSpecial Paste:=xlPasteAll,   Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Windows("970306日報1.xls").Activate Range("C33:C38").Select Application.CutCopyMode = False Selection.Copy Windows("日報リスト.xls").Activate Range("H2").Select Selection.PasteSpecial Paste:=xlPasteAll,   Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = False ActiveWorkbook.Save Windows("970306日報1.xls").Activate ActiveWindow.Close -----------------------------------------

  • ExcelVBAで選択範囲のみ新規ブックにコピペ(EXCEL2007)

    ExcelVBAで選択範囲のみ新規ブックにコピペ(EXCEL2007) EXCEL2007にて下記VBAプログラムを実行すると、 ActiveSheet.PasteSpecialの部分で 「アプリケーション定義またはオブジェクト定義のエラーです。」 とエラーメッセージがでます。 なぜなのでしょうか? お願いいたします。 '選択範囲コピー Range("AllData").Copy '新規ブックの追加 Set WB = Workbooks.add WB.Activate ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False

専門家に質問してみよう