• 締切済み

シートコピーでフォントが変わる

Excel2016を使用しています。 マクロにてシートコピーする処理を行っているのですが、コピー後のフォントがオリジナルと変わってしまう事象に悩んでおります。 ブックAからブックBへ、ブックAのシートAとシートBをworkbooks.sheets.copyを利用してコピーしています。 シートAは問題なくコピーされます。 シートBは内容自体は問題ないのですが、一部分だけフォントが変わってしまいます。 基本的にはMS Pゴシックだったものが、游ゴシックに変わってしまいます(添付画像を見てもらえればと思います)。 ※部分はシートAとシートBで違いがあった場合のチェック用に関数が入っており、シートコピー後に値の貼り付けをして文字列に変えています。 どうして一部のフォントが変わってしまうのでしょうか? ご存知の方はいらっしゃいますでしょうか? ちなみにExcelの新規作成時のフォントは游ゴシックです。

みんなの回答

  • HohoPapa
  • ベストアンサー率65% (454/690)
回答No.1

マクロのよらず、手作業でコピーしても同じ結果になるのかを 確認してみてください。 手作業によっても再現するのであれば、次の事象を疑います。 セルに設定されているフォントがMS Pゴシックとしてあったとしても 課題セルに明示的にそのフォントを設定している場合と 課題セルに設定しているフォントが テーマのフォントで、かつ、そのテーマのフォントが MS Pゴシックの場合とがあります。 後者の場合、シートがブックを跨いでコピーされた場合、 コピー先のブックが選択しているテーマに紐づいたフォントに変化します。 前者なのか後者なのかは https://okwave.jp/qa/q9545635.html で説明したつもりですので確認してみてください。

関連するQ&A

  • エクセルのシートのコピーについて

    シートのコピーをVBAで行いたいのですが、エラーになってしまいます。 間違っている箇所が分からないのでご教授お願いします。 貼り付けというブックにマクロが組まれています。 ”データ”のブックにあるシート名が”貼り付けのブックのリスト”のシートに記載されています。 リストのシートに記載されているシートを貼り付けのブックにコピーしたいです。 よろしくお願いします。 Sub シートコピー() 行数 = 2 Do Until IsEmpty(Cells(行数, 3).Value) コピー元 = Workbooks("貼り付け.xls").Worksheet("リスト").Cells(行数, 3) Workbooks("データ.xls").Worksheet(コピー元).Copy After:=Workbooks("貼り付け.xls").Sheets(Workbooks("貼り付け.xls").Sheets.Count) 行数 = 行数 + 1 Loop End Sub

  • ブックの保護(シート構成) でシートのコピー

    エクセルで外部データを参照させるために, 別のブックを開きシートをコピーし元のブックに貼り付け別のブックは閉じるというマクロを作成しました。 Workbooks.Open Filename:=a Sheets("データ").Select Sheets("データ").Copy After:=Workbooks("ファイル.xls").Sheets("メニュー") Workbooks(a).Close SaveChanges:=False a(変数)というファイルを開く シートのデータを選択 データをコピーし ファイル.xls のメニューシートの後に貼り付け a(変数)のエクセルファイルを保存せずに閉じる 動作としては正常に動きました。 しかし、この ファイル.xls には ID とパスワードで管理しています。 その管理したシートがあるんですが、それを表示させないために シートを非表示→ブックの保護→シート構成 を行いました。 マクロを動かすと、シート構成をしているので Sheets("データ").Copy After:=Workbooks("ファイル.xls").Sheets("メニュー")  が動かないことに気が付きました。 何かいい方法があればご教授お願いします。

  • シートを別のブックに複数自動コピー

    初質問です。よろしくお願いします。 マクロを使って、あるブックのシート(20から50枚程度)を、別の貼り付け先のブックに自動的にコピーしようとすると、10回をすぎたあたり(必ずしも一定せず)で 「実行時エラー'1004': WorksheetクラスのCopyメソッドが失敗しました。」 というエラーと共にマクロが止まり、デバッグしようとすると 「ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート")」 のところで止まっています。 マクロの記述内容は以下の通りです。 Sheets("貼り付け元シート").Activate ActiveSheet.Copy After:=Workbooks("貼り付け先ブック.xls").Sheets("○○シート") Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("A1").Select Windows("貼り付け元ブック.xls").Activate ・・・以下貼り付け元シートを変えつつ複数回繰り返し これができる様になれば非常にラクになるので、ぜひご教授願います。

  • エクセルのマクロでシートのコピー

    いつもお世話になっております。 エクセル2000で次のことをマクロで行いたいのです。 いくつかWorkbookが開いている状態で、シートのコピーを行うのですが、シート名やブック名はその都度違います。 具体的には、Workbook"A" に "a"、"b"、"c" の3つのシート、Workbook"B" に "f"、"g"、"h"の3つのシートがあり、 Workbook"A" の Sheet("a") を Workbook"B" の Sheet("h") の前にコピーしたいのです。 Sheets(1).Copy before:=Workbooks("B.xls").Sheets(3) ところがWorkbookの名前がその都度変わるので困っています。 ブック間の移動は ActiveWindow.ActivateNext などで行っていますがシートのコピーがどうしても分からないので お願いします。  

  • エクセル ブック間コピー マクロ

    ブックA(ブック名は固定)のシートA(シート名は毎回違います)を ブックB(ブック名は固定)の一番左へコピーしたいのですがうまくいきません。 動作 :シートAでマクロを実行しブックBへシートのコピー(挿入)します。 まず第一段階のブックAのシートAをブックBへのコピーがうまくいきません。 シートAが固定シート名ならコードは Sheets("A").Select Sheets("A").Copy Before:=Workbooks("B.xls").Sheets(1) ですが・・・・ Sheets("A").SelectをWith ActiveSheet.Selectにすれば良いのですか? 申し訳ないのですが、後教授お願いします。

  • エクセル 特定のシートを異なるブックの指定したシートにコピーするマクロ

    エクセルの"貼り付け先.xls"の(シート名="集計")を開いている状態で、 別の異なるブックの"貼り付け元.xls"の(シート名="sheet1")の内容を全部コピーして "貼り付け先.xls"の(シート名="集計元データ")へ貼り付けるマクロは どのようになりますでしょうか? いろいろ調べて下記のように書きましたが、 インデックスが有効範囲にありませんというメッセージが出て、 デバッグを確認すると Workbooks("貼り付け元.xls").Worksheets("Sheet1").Range("A1").Copy_の部分が黄色く表示されてきます。 (1) "貼り付け先.xls"と"貼り付け元.xls"は同じパソコンのマイドキュメントに保存されています。 (2)"貼り付け元.xls"の"Sheet1"はセルA1から入力されていて、 内容は毎日変わります。 (3)Range("A1")や("A1:IV65536")のセル番地をいろいろ変えたりしても同じでした。 Sub クリップボードを経由せずにコピー貼り付けする_異なるブック() Workbooks("貼り付け元.xls").Worksheets("Sheet1").Range("A1").Copy_ Workbooks("貼り付け先.xls").Worksheets("集計元データ.xls").Range ("A1:IV65536") End Sub

  • ワークシートをコピーしたい

    下記載のサンプルマクロは「ワークシートをコピーして、追加したワークブックにコピペする」マクロなんですが、これを「ワークシートをコピーして、追加したワークシートにコピペする」にできないでしょうか? 出来るのであれば、値と書式の他に関数もそのまま貼り付けたいので御教授お願いします。 ただマクロは削除してマクロ抜きのコピペが理想です。 宜しくお願い致します。 Sub サンプル() Dim sc As Integer sc = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 ThisWorkbook.Sheets("オリジナル").Cells.Copy 'コピー Workbooks.Add 'ブック追加 Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlValues '値貼り付け Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlFormats '書式貼り付け Sheets("Sheet1").Name = "コピー" Application.CutCopyMode = False Application.SheetsInNewWorkbook = sc ActiveWorkbook.Close ThisWorkbook.Activate End Sub

  • WorkBooksをオープンさせずにシートにコピーしたい【EXCEL VBA】

    よろしくお願いします。 今あるブックにあるシートを別のブックにコピーしたいのですが、今考えているのは ここから//////// 'ブックを開く Workbooks.Open コピー元のブックのパス 'シートをコピー Worksheets.Item(コピーするシート名).Copy _ after:=Workbooks(コピー先のブック名).Sheets(1) 'ブックを閉じる Application.DisplayAlerts = False Workbooks.Item(コピー元のブック名)Close True Application.DisplayAlerts = True ここまで//// なのですが、コピーものとのブックが複数ある時、画面がチラチラしてしまいます。ブックをオープンさせずにシートを他ブックにコピーさせる方法ってないでしょうか。 ご存知の方がいらっしゃいましたら、ご教授お願いします。

  • ExcelVBAでBook間のシートコピーについて

    以前、Excel2003を使用しているときに作成したファイルで、2003の時には特に問題なく動いたのですが、Excel2010に入れ替えてからうまくいきません。 コードは以下のようなもので、コピーするシートには埋め込みグラフ(ソースは同一シート)があります。 Dim Book_A As Workbook Dim Book_B As Workbook Set Book_A = ThisWorkbook Set Book_B = Workbooks.Open("D:\Book_B.xls") For i = 1 To 3 Book_A.Sheets(i).Copy Before:=Book_B.Sheets(i)   '※ Next i 上記※印の部分で下記のエラーが発生します。 実行時エラー '-2147417848(80010108)': オートメーションエラーです。 起動されたオブジェクトはクライアントから切断されました。 となり、止まってしまいます。 また、同じファイルを2003の入った端末から実行するとエラーは発生しません。 また、2010の入った端末で試しにシート見出しを右クリックして別のBookにコピーをしたところ、グラフやテキストボックスが抜け落ちたものがコピーされます。 2010では方法が違うのでしょうか?

  • VB6でExcelシートのコピー、貼付け

    VB6でExcelファイルを開いてシートをコピーし、新規ファイルとして保存したいのですが方法がわかりません。 (既存のExcelシートを雛形として新しくBookを作りたいんです) Set objexcel = CreateObject ("Excel.Application") Set objexcel_new = CreateObject("Excel.Application") objexcel.Workbooks.open (App.Path & "\book1.xls") objexcel_new.Workbooks.Add '新規に作る 'シートのコピー objexcel.sheets("Sheet1").Copy objexcel_new.sheets("Sheet1").Select objexcel_new.activesheet.Paste としても、実行前のクリップボードの中身が貼り付けられるだけで、シートがコピーできません。 よろしくお願いします。

専門家に質問してみよう