VBAでExcelファイルをコピーして保存する方法

このQ&Aのポイント
  • Excel VBAを使用して、ファイルシートをすべて選択し、名前をつけて保存する方法について教えてください。
  • 保存されるファイルのグラフの元データが、コピー元ではなくコピー先になってしまう問題について、修正方法を教えてください。
  • ThisWorkbook.Worksheets.Copyを使用してファイルをコピーし、SaveAsメソッドを使用して名前をつけて保存します。その際、保存先のファイルのグラフの元データをコピー元ではなくコピー先にする方法を教えてください。
回答を見る
  • ベストアンサー

excel vbaで助けてください

excel2000を利用しています。 ファイルA (sheet1-グラフデータ、sheet2-グラフ)が、あります。 Vbaで、このファイルシートをすべて選択して、コピーして、名前をつけて保存しています。 この時に、作られる ファイルB (sheet1-グラフデータ、sheet2-グラフ)ですが、グラフの元データが、ファイルAになってしまいます。 下記、記述をどのように修正すれば、ファイルBのグラフの元データを、ファイルAでなく、ファイルBにすることが出来るでしょうか。 ご教授お願いいたします。 Thisworkbook.Worksheets.Copy SaveFilePath = Application.GetSaveAsFilename(mypath,"ExcelFile(*.xls),*.xls") If SavefilePath <> "False" Then ActiveWorkbook.SaveAs Filename:=SaveFilePath Else End if

  • puyopa
  • お礼率87% (459/525)

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

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

こんにちは。 こんな感じ? ' '  ―――――――――――――――――――――――――――   SaveFilePath = Application.GetSaveAsFilename(mypath, "ExcelFile(*.xls),*.xls")   If SaveFilePath <> "False" Then     ActiveWorkbook.SaveCopyAs Filename:=SaveFilePath '(1/2択)アクティブなブック '    ThisWorkbook.SaveCopyAs Filename:=SaveFilePath '(2/2択)自ブック     Workbooks.Open Filename:=SaveFilePath ' 開く場合   Else   End If ' '  ――――――――――――――――――――――――――― 或いは、 元のブックのシート数が幾つであっても 左からふたつのシートだけをコピーする場合は以下。 ' '  ――――――――――――――――――――――――――― Dim i As Long   SaveFilePath = Application.GetSaveAsFilename(mypath, "ExcelFile(*.xls),*.xls")   If SaveFilePath <> "False" Then     ActiveWorkbook.SaveCopyAs Filename:=SaveFilePath '(1/2択)アクティブなブック '    ThisWorkbook.SaveCopyAs Filename:=SaveFilePath '(2/2択)自ブック     With Workbooks.Open(Filename:=SaveFilePath)       Application.DisplayAlerts = False       For i = .Sheets.Count To 3 Step -1         .Sheets(i).Delete       Next i       Application.DisplayAlerts = True       .Close True '(1/2択)閉じる '      .Save '(2/2択)閉じずに上書きのみ     End With   Else   End If ' '  ―――――――――――――――――――――――――――

puyopa
質問者

お礼

おぉー、これは助かります。大変興味深いです。 いろんなパターンをご提示いただけたので、いろんなパターンの勉強にもなりました。 とても、親切なお気遣いに感謝いたします。 ありがとうございました。

関連するQ&A

  • エクセルVBAで困っています。

    Excell2003でマクロを作成したのですが、思うような結果が出なくて困っています。 どなたかお力をお貸しください。 お願いします。 【作成したマクロ】 Sub テスト()   myPath = ThisWorkbook.Path   buf = Dir(myPath & "¥データ¥" & "*.xls")   Do While buf <> ""     Target = "'" & myPath & "[" & buf & "]Sheet1'!R1C1"     i = i + 1     Cells(i, 1) = buf     Cells(i, 2) = ExecuteExcel4Macro(Target)     buf = Dir()   Loop End Sub 【設定状況】 ・デスクトップ上に "サンプル.xls" があり、ThisWorkBookに上記マクロを書きました。 ・デスクトップ上に "データ" というフォルダがあり、その中に、"Book1.xls" と "Book2.xls" があります。 ・"Book1.xls" のSheet1のRange("A1")には "あいうえお" が入力されています。 ・"Book2.xls" のSheet1のRange("A1")には "かきくけこ" が入力されています。 【マクロ実行結果】 ・Range("A1") ・・・ Book1.xls ・Range("B1") ・・・ #REF! ・Range("A2") ・・・ Book2.xls ・Range("B2") ・・・ #REF! となってしまいます。 【求めたい結果】 ・Range("A1") ・・・ Book1.xls ・Range("B1") ・・・ あいうえお ・Range("A2") ・・・ Book2.xls ・Range("B2") ・・・ かきくけこ よろしくお願いします。

  • エクセルVBAについて

    エクセルVBAの名前を付けて保存について質問です。 名前を付けて保存するとき、保存先に同じ名前のファイルがあると 「この場所に○○というファイルがありますが置き換えますか?」 と表示され「いいえ」もしくは「キャンセル」を選択すると実行時 エラーが表示されます。 キャンセルしてもエラーが出ないような構文を書きたいのですが わかりません。 もし知っている方がいるようでしたら教えてください。 Dim MySavePath As String MySavePath = Application.GetSaveAsFilename(Date, "Excel ファイル (*.xls), *.xls") If MySavePath <> "False" Then ThisWorkbook.SaveAs MySavePath & ".xls" End If

  • EXCELのVBAでの保存方法

    EXCELで以下のように記述したところ、 「ファイルを置き換えますか」のメッセージの後に 「いいえ」か「キャンセル」を選択すると 「400」というエラーメッセージが表示されます。 「いいえ」か「キャンセル」を選択した場合は、 エラーメッセージを表示させずに、 特定のシートのセルA1にカーソルを移動させたいのですが、可能でしょうか? ご指導よろしくお願いします。 ________________________ FileA = Application.GetSaveAsFilename( _ InitialFilename:="C:\test.xls", _ fileFilter:="XLSファイル (*.xls), *.xls") ActiveWorkbook.SaveAs Filename:=FileA ________________________

  • エクセルVBAでConsolidate

    以下は、ネット検索で見つけたサンプルコードです。 同じフォルダ内の全ブックのSheet1のA1:B10をThisWorkbookのSheet1に統合しています。 Sub test2() Dim MyFile As String, MyPath As String Dim SumFile() As Variant, i As Long MyPath = ThisWorkbook.Path & "\" MyFile = Dir(MyPath, vbNormal) Do Until MyFile = "" If MyFile <> ThisWorkbook.Name Then ReDim Preserve SumFile(i) 'A1からB10の値を変数に代入 SumFile(i) = "'" & MyPath & "[" & MyFile & "]Sheet1'!R1C1:R10C2" i = i + 1 End If MyFile = Dir Loop If i = 0 Then MsgBox "データが有りません": Exit Sub Worksheets("Sheet1").Range("A1").Consolidate Sources:=SumFile() End Sub 質問1 Sheet1だけでなく全シートのA1:B10をThisWorkbookのSheet1に統合するためにはどう書き換えればよいのでしょうか? 質問2 上記コードではなぜ、ブックを開かずにデータがとれるのでしょうか?

  • VBAでVBAを削除?

    作業中のブックから一枚のシートを以下のSub 別ファイル保存()プロシージャで別のブックとして保存します。それはうまくいったのですが、この元になるシートには Private Sub Worksheet_SelectionChange(ByVal Target As Range) '途中略 End Sub と Private Sub Worksheet_Deactivate() '途中略 End Sub の二つのVBAが記述してあり、これまで一緒に別のブックに入ってしまいます。 これを防ぐにはどのようにすればよいのでしょうか? Sub 別ファイル保存() mypath = ThisWorkbook.Path fn = Sheets("Declarations").Range("H15").Value & Format(Date, "yymmdd") ffn = mypath & "\" & fn & ".xls" Sheets("Declarations").Copy ActiveWorkbook.SaveAs Filename:=ffn ActiveWorkbook.Close End Sub

  • VBAでも新規ファイル作成

    Excel2003です。 下記のコードであるシートを別ファイルにして保存するコードを書いています。ただ、このコードでは、コピー元のシートにExcel関数が入っているために、出来上がった新規ファイルを開くときに常に”リンクの更新”を聞かれてしまいます。リンクの更新をする必要はないのでファイルを開くたびに”更新しない”を選択してもよいのですが、初めからこの”リンクの更新”メッセージが出ないようにするには何か良い手立てはないでしょうか? ------------------------------------------------------------- Sub ファイル作成() '報告書を"名前を付けて保存" Sheets("Sheet1").Select Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant 既定ファイル名 = "新規報告書" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Sheets("Sheet1").Select Else With ThisWorkbook.ActiveSheet Workbooks.Add .Copy After:=ActiveWorkbook.Sheets(1) Application.DisplayAlerts = False ActiveWorkbook.Sheets(1).Delete Application.DisplayAlerts = True ActiveWorkbook.SaveAs 保存ファイル名, xlNormal ActiveWorkbook.Close False End With Sheets("Sheet1").Select End If End Sub ---------------------------------------------------------------

  • エクセルVBAで書式と値の貼付けにつて

    エクセル2007VBAで新規ファイルを作る場合のコピー、貼り付けで質問しましたが 式も全て貼り付けになるとUSBメモリーで持ち出した場合、エラーとなります。 それで値と書式のみ貼り付けする様下記の様に書き直しましたが、.PasteSpecialでメソッドまたはデータメンバーが見つかりませんとなります。 ぐぐっててヘルプを見ますが解決出来ません。どなたがご教授お願いします。 元の式 Sub DGCopy() Workbooks.Add With ThisWorkbook .Sheets(5).Cells.Copy Sheets(1).Cells Sheets(1).Select Sheets("Sheet1").Name = "電気代" .Sheets(6).Cells.Copy Sheets(2).Cells Sheets(2).Select Sheets("Sheet2").Name = "ガス代" F = Application.GetSaveAsFilename(FileFilter:="Excelブック (*.xls),*.xls)") If F = "False" Then Exit Sub ' ダイアログでCancelをクリックした場合 ActiveWorkbook.SaveAs Filename:=CStr(F) End With End Sub 書き直した式 Sub DGCopy() Workbooks.Add With ThisWorkbook Sheets(5).Select Cells.Selection.Copy Sheets(1).Selection .PasteSpecial Paste:=xlPasteFormats ←エラー部分 .PasteSpecial Paste:=xlPasteValues Sheets("sheets1").Name = "電気代" Sheets(6).Select Cells.Selection.Copy Sheets(2).Selection .PasteSpecial Paste:=xlPasteFormats .PasteSpecial Paste:=xlPasteValues Sheets("sheets2").Name = "ガス代" F = Application.GetSaveAsFilename(FileFilter:="Excelブック (*.xls),*.xls)") If F = "False" Then Exit Sub ActiveWorkbook.SaveAs Filename:=CStr(F) End With End Sub

  • エクセルVBAでの質問です。

    まとめ.xlsに、「まとめ」「グラフ」「A」「B」「C」「D」「E」というシートがあって、それと一緒に、A.xls、B.xls、C.xls、D.xls、E.xlsというファイルを開いた際に、A.xlsの、G2:I54をまとめ.xlsのAのシートのA1に、B.xlsの、G2:I54をまとめ.xlsのBのシートのA1に・・・といった感じでコピーを行いたいと思い、以下のようにマクロを組みました。 Dim I(4) As String I(0) = "A" I(1) = "B" I(2) = "C" I(3) = "D" I(4) = "E" Sheets("まとめ").Select For J = 0 To 4 Step 1 Sheets("" + I(J) + "").Select Windows("" + I(J) + ".xls").Activate Range("G2:I54").Select Selection.Copy ThisWorkbook.Activate Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False Workbooks("" + I(J) + ".xls").Close SaveChanges:=False Next J ThisWorkbook.Activate Sheets("まとめ").Select Range("A1").Select この状態では、必ずA~Eのシートと、A~E.xlsが存在しないと処理できないのですが、情報量が変わった場合でも同じような処理を行いたいのです。 たとえば、A~CのシートとA~C.xlsしかない場合、 アルファベットではなく、1~3といった場合、 5枚だけではなく、10枚など増えた場合。 まとめ.xlsの「まとめ」と、「グラフ」のシートには、それぞれA~Eに貼られたデータから引用したり、グラフ化したりしているため、シートの入れ替えは行うことができず、純粋に、「値のコピー」としてもってきたいと思っています。 原則として、A~Eのシートに貼り付けるA~E.xlsに存在するシート名は、A.xlsはA、B.xlsはB・・・といった感じになっています。 それが数字になっても、文字になってもその規則に変更はありません。 分かりにくい説明ですみません。 分かる方、よろしくお願いします。

  • VBA 新規作成したファイルを開くときにエラー

    すみません、助けてください。 Excel 2007のVBAでActiveWorkbook.SaveAsを使って 新規にExcelファイルを生成するものを作成しているのですが、 新たに作成したExcelファイルを開くときにエラー(警告)が出てしまいます。 (ファイル自体は開けるのですが。。。) ソースは以下です。 ------------------------------------------------------------ ' シート枚数を指定 Application.SheetsInNewWorkbook = 3 Workbooks.Add ' 上書き保存 Application.DisplayAlerts = False ' ファイル名を指定して保存 ActiveWorkbook.SaveAs (ThisWorkbook.Path + "\" + "新しいファイル.xls")

  • Excelで、少しプログラムのようなことがしたいのですが・・・

    『A.csv』と『B.xls』のように、別々のexcelfile(または、sheet)で、どちらにも同じ項目の『C』という列があるとします。 その列の入力されているデータ(数値)が一致したとき、『B.xls』のfile(または、sheet)の『C』という列のセルにそのデータ(数値)記入させる。 …みたいなプログラムをExcelでしたいのですが、できるでしょうか?

専門家に質問してみよう