• ベストアンサー

【Excel VBA】シートコピー時、マクロコードはコピーしたくない

ws.copy Before:=Workbooks(File).Sheets(1) Windows(File).Activate Cells.Select Selection.copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 上記コードで、シートのコピー・貼付を行っていますが、 コピー元シートのコードも引き継がれてしまいます。 引き継がれないようにコピーしたいのですが、可能でしょうか? 可不可について、 可能ならばそのやり方(コード)を教えていただけないでしょうか? よろしくお願いします。

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

  • ベストアンサー
  • cj_mover
  • ベストアンサー率76% (292/381)
回答No.4

こんにちは ご質問で求められている結果に対する理解が不充分かも知れませんが、   シート(ws)のコピーを、ブック(file)Sheet1の直前に 挿入   作成したシートの、数式の戻り値を 値に 直す   シートモジュールのコピーを除いたコード、、、 というお話だと理解しました。 #2さんと殆ど同じなのですが、 元のシート(ws)の書式が新しいシートに反映されるようになってます。 コメントはコピーされますが、他のShapeは残りません。 もし、Shapeまでコピーするのでしたら、別途、ご質問されるとよいと思います。 #3も禁じ手と仰っていますが、 VBAのコードそのものを書き換える方法は、 それ以外に方法がない場合の非常手段だとしても、 余程パーソナルな用途でしか考えない方が良いです。 仕事で使うことが内規違反になる可能性もあるし、 使えない環境もありますので、 私も回答には書きたくないですね。   ◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇ Sub TEST() Const sFile As String = "ファイル名.xls" ' ※ Dim ws As Worksheet ' ※   Application.ScreenUpdating = False ' ※   Set ws = ThisWorkbook.Sheets(1) ' ※   With Workbooks(sFile).Worksheets   With .Add(Before:=.Item(1))     ws.Cells.Copy .Cells     .UsedRange.Value = .UsedRange.Value     .Activate   Application.ScreenUpdating = True ' ※ '    MsgBox "Done" ' ※ '    .Delete ' ※   End With   End With End Sub   ◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇      ' ※ の行は、便宜的な記述です。 ご質問と関係ないことを書くことを、お許し下さい。 どうしても書いておきたいので、、、 Wendy02 さん あなたがいないと、困ります。 出来れば、考え直して頂きたいけれど、 多く学ばせて頂いた一人として、感謝しています。 ありがとう ござい ます!!

motsu2006
質問者

お礼

ご回答、ありがとうございました。 ご理解、まさにその通りです。 私が詳細を記述しなかったのでたいへんお手数をおかけしました。 なるほど、私にとって禁じ手を使用するのはまだ危険なようですね。 もう少し上達してから、参考にさせていただきます。 追伸:私もWendy02さんには非常に助けられた一人です。    何かあったのか存じ上げませんが、    Wendy02さんはじめこのカテに回答してくださる皆様、    今後ともよろしくお願いします。

その他の回答 (3)

  • okormazd
  • ベストアンサー率50% (1224/2411)
回答No.3

可能ですが、推奨はできません。禁じ手とか。 コピーされたコードを削除すればいいですよね。 貼り付けられたSheetの名前のコードを削除する。 参考 http://okwave.jp/qa3859010.html の ANo.4

motsu2006
質問者

お礼

ご回答ありがとうございます。 リンク、拝見しました。 私のような初心者には厳しいというかやらない方がよさそうですね、 おっしゃるとおりです。 >注意 うまくできないとExcelの動作がおかしくなることがあるかもしれない。 →怖いですね。  コピー元の方は半年かけて作成した大作(自分的に^^;)なので リンク先のやりとりはローカルに保存させていただき、 もっとVBAスキルが向上したら使わせていただくかもしれません。

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんばんは。 ws.copy Before:=Workbooks(File).Sheets(1) ws を明記していませんし、前の部分でどんな設定されているかは、想像の範囲しかありませんが、おそらく、その部分で、シートのマクロのコピーが出来ています。 '------------------------------- Set ws = ThisWorkbook.Worksheets(1) With Workbooks(File).Sheets.Add(Before:=Workbooks(File).Sheets(1))   ws.Cells.Copy   .Range("A1").PasteSpecial Paste:=xlPasteValues   .Name = ws.Name & "_"  'シート名の設定 End With '-------------------------------

motsu2006
質問者

お礼

Wendy02さん、いつもお世話になっています。 私、いつまで経っても初心者の域を抜け出せず、お恥ずかしい限りです、、、。 ご想像の通りです。 教えていただいたソース、参考にさせていただきます。

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

私がモジュール1にVBAコードのある、あるブックを開いて、シートの範囲指定して、コピーし、新しいエクセルを開きSheets(1)に貼り付けました。 保存して開きましたが、モジュール1は現れません。 事実は間違いないですか。 Personal.xlsとの関連(そっちを見ていること)無いですか。 http://www.relief.jp/itnote/archives/002060.php >PERSONAL.XLSファイルが存在している場合、Excelが起動する際に非表示状態でPERSONAL.XLSも一緒に開かれているので、個人用マクロブックに保存したマクロは、どのExcelファイルからでも利用することができるようになっています。

motsu2006
質問者

お礼

ご回答ありがとうございます。 >シートの範囲指定して、コピーし、新しいエクセルを開きSheets(1)に貼り付けました。 いえ、私の場合はシートそのものを別ブックにコピーしています(範囲指定ではない)。 また標準モジュールではなく、シートモジュールのコードがそのまま引き継がれないことが希望なのですが、、、。

motsu2006
質問者

補足

失礼しました! 私のもある意味範囲指定でした(シート全体を範囲指定している、という意味でした)。 お礼欄は上記を読み替えてください。申し訳ありません。

関連する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

  • エクセルマクロVBAについて

    エクセルマクロVBAについて、こんなこと出来ますか? ■A列からAS列の1行目にヘッダー情報をもつデータベース ■A列に担当者名 ■A列にオートフィルタをかけて各担当ごとにデータを抽出したものを別シートに貼り付けて自動印刷したい ■担当者は都度変わるので、Criteria1:="xxx"というようには直接書けない(担当名を自動で抽出したい) ■担当者の数も都度変わる ■補足 一行のデータを特定の雛形に転記する必要があるので別シートに出したいです ちなみに、アナログで記録したコードは以下です。 Sub test1() Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="山田" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="斉藤" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="田中" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 End Sub これ、担当者の抽出を自動でなんとかなりませんか?

  • EXCEL VBAで複数行のコピー(バックグランド)

    EXCELのVBAで質問します。 複数行をコピーしてPasteを行う方法がわかりません。 フォアグランドでは正しく実行できるのですが、バックグランドで実行した場合は、1行しかPasteできません。 お分かりの方いらっしゃれば教えてください。 コードは以下のとおりです。 Sheets(\"DATA\").Select Range(\"A3:W26\").Select Selection.Copy Range(\"A4\").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=True 宜しくお願いします。

  • 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位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。

  • VBA マクロ実行時エラー’1004RangeクラスのPasteSpecialメソッドが失敗

    マクロ実行時に、エラー’1004RangeクラスのPasteSpecialメソッドが失敗と表記され、マクロが実行されません。 マクロの内容は、任意の範囲をコピー、新規book追加し、 新規bookに(1)Paste:=xlPasteValues (2)Paste:=xlPasteColumnWidths (3)Paste:=xlPasteFormats の順に貼り付けし保存するものです。 いろいろ調べては見たのですが、当方初心者の為、わからずじまいです。お手数ではございますが、どなたかご教授願います。 下記にマクロ内容全部記載します。 よろしくお願いします。 ********************************************************* ********************************************************* Sub 日報別ファイルに保存したい1() Worksheets("日報").Range("A3:AF36").Copy With Workbooks.Add Cells.Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Cells.Select Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Range("A1").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ApplicationDisplayAlerts = True '同名FILEが存在する場合' ActiveWorkbook.SaveAs Filename:= _ "c:\日報\" & ActiveSheet.Range("J2") & "年" & ActiveSheet.Range("l2") & "月" & ActiveSheet.Range("n2") & "日_日報.xls" _ , FileFormat:=xlNormal .Close file End With End Sub

  • VBA 他のブックから複数のシートのデータをコピー

    VBA初心者です。 他のブックの複数のシートの最終行のデータをコピーし1つのシートにまとめたいと思っています。 参照元 シート1 最終行20 AからD シート2 最終行30 AからD シート3 最終行15 AからD のそれぞれのデータ メインシート 1行目 シート1のAからD 2行目 シート2のAからD 3行目 シート3のAからD を値のみ貼り付けたいです 色々と検索しチャレンジするシート1のみであればなんとか成功するまで完成したのですが、インデックスが有効ではありませんとでてエラーがでます。原因は、シート2のデータをコピーする際、参照元のファイルがActiveになっていないからだと考えているのですが、参照元のファイル名が毎回違いますので、ファイルを選択してファイルを開いてから作成しようとチャレンジしています。 Sub Copy() 'コピー元のファイルを選択して開く Dim OpenFile As String ChDir "C:\Users\name\Documents\folder" OpenFile = Application.GetOpenFilename("Excelブック,*.xlsx") MsgBox OpenFile & " を開きます" Workbooks.Open FileName:=OpenFile 'データをコピー 'シート1 Worksheets("シート1").Range("A20:D20").Copy Workbooks("メインブック.xlsm").Worksheets("メインシート").Activate Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'シート2 Worksheets("シート2").Range("A30:D30").Copy Workbooks("メインブック.xlsm").Worksheets("メインシート").Activate Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 良きアドバイスよろしくお願いします。

  • 指定セルをコピー

    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

  • Excel vba selectが効かない

    2と3の2つのエクセルファイルがあります。縦の列を新しいファイルの横の行に コピーしていきたいプログラムです。 2のファイルの1シート目の"C8:C25" 3のファイルの1シート目の"C9:C65" を新しい1のファイルの1シート目の1行目にコピーするプログラムを 作っていますが1シート目はpasteされるのですが 3のファイル2シート目からselectの指定が"C9:C65"ではなく、B9からQ65の指定になってしまい思ったコピーができません(★のところ)、1シート目はうまくいっているのでどうして3のファイルの2シート目のからうまくいかないかわかりません。 5シートまででテストをしているのですが実際は各々255シートありもってくる列も 12列あります。とりあえずCの列だけ5シートで試してみています。 Dim i As Long Dim N As Long i = 1 N = 1 Do While i <= 5 ''C列''' Workbooks(2).Worksheets(i).Activate   '2のファイル Worksheets(i).Range("C8:C25").Select   'もってくるところ Selection.Copy Workbooks(1).Worksheets(1).Activate   '1新しいファイル Range("C" & N).Select   '貼り付けるところ Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True Workbooks(3).Worksheets(i).Activate   '3のファイル Workbooks(3).Worksheets(i).Range("C9:C65").Select  '★もってくるところ Selection.Copy Workbooks(1).Worksheets(1).Activate   '1新しいファイル Range("U" & N).Select   '貼り付けるところ Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True i=i+1 N=N+1 LOOP

  • Visual Basicのエラー

    以下のプログラムで Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False の部分で「コピー領域と貼り付け領域の形が違うため、情報を貼り付けることができません。」というエラーが出てしまいます。 因みに、コピー元もコピー先も結合セルはありません。 どのように修正すればよいのでしょうか? -------------------------------------------------------------------------------- Retu = Array(, 2, 17, 10, 9, 6, 7, 8) For N = 1 To 7 'Array関数Indexは0から始まるため、最後は抽出列数より1少ないものになる。 計上Sheet1.Activate 計上Sheet1.Range(Cells(5, Retu(N)), Cells(Sheet1件数MaxRow, Retu(N))).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy 計上Sheet3.Activate 計上Sheet3.Cells(25, N).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False

  • 【Excel VBA】 多くのファイルからのコピー貼り付け連続処理

    【やりたいこと】 アンケートを取った500個のxlsファイル(ファイル名は"001.xls"~"500.xls"まで、単純に規則的に数字が増えていく)があります。500個のファイルの中身(アンケートのフォーマット)は全て同じで、回答者の「答え」は"アンケート"というシートの"P6:S6"と"A70:AX70"という範囲に数列になって入っています。 この500個のファイルに対して、 (1)シートにはPassword付きの保護がかけてあるので、アンケート回答ファイルを開いたら保護を解除する (2)"アンケート"というシートの、ある範囲(回答部分の"P6:S6"と"A70:AX70")をコピーし、集計用の別ファイルへ貼り付けていく(×500人分) (3)集計用の別ファイルに貼り付けるときは、1人目の"P6:S6"範囲の貼り付け先は"D4"、"A70:AX70"の範囲の貼り付け先は"I4"で、2人目はそれぞれ"D5"と"I5"、3人目は"D6"と"I6"、・・・とずらしていきます。(コピー元のセルは同じで、コピー先のセルがずれていきます) (4)コピー貼り付けが終わったアンケート回答は、上書き保存をせずに終了する(再び保護がかかった状態に戻して終了する) という操作を行うマクロを組みたいのです。 【つまづいている現状・・・】 とりあえず1人目の分だけ記録したマクロは以下の通りです。力技でやろうとすれば、"001.xls"を001~500まで、"D4"と"I4"を4~503まで、ずっと書き変えていけばいいんだと思いますが・・・。500人分を簡単にスッキリとまとめることはできませんでしょうか? 何卒よろしくお願い致します。 -------------------------------------------------------------- Workbooks.Open Filename:="D:\AAA\001.xls" Sheets("アンケート").Select ActiveSheet.Unprotect Password:="1234" Range("P6:S6").Select Selection.Copy Windows("集計用ファイル.xls").Activate Range("D4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("001.xls").Activate ActiveWindow.SmallScroll Down:=8 Range("A70:AX70").Select Application.CutCopyMode = False Selection.Copy Windows("集計用ファイル.xls").Activate Range("I4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("001.xls").Activate Application.DisplayAlerts = False ActiveWindow.Close --------------------------------------------------------------

専門家に質問してみよう