ACCESS VBAで作成済のExcelのコピーを作りたい

2023/10/13 16:33

このQ&Aのポイント

ACCESS VBAで作成済みのExcelファイルのコピーを作成し、テーブルのデータを出力する方法を教えてください。
ACCESS VBAを使用して、複数シートを持つExcelファイルのコピーを作成する方法について教えてください。
ACCESS VBAでExcelのコピー作成をする際、シートが複数ある場合の具体的な手順を教えてください。

ベストアンサー

ACCESS VBAで作成済のExcelのコピーを作りたい

2005/11/29 18:28

ACCESS VBAで作成済みのExcelファイル (複数シートがあります）のコピーを作成しそのファイルでテーブルのデータを出力したいと思っています。シートが１つならできましたがシートが複数あるとできません。できる方法を教えてください。なおシートが一つの場合は、下記でできました。 Dim oXLS As New Excel.Application Dim NewBook As Excel.Workbook oXLS.Workbooks.Open Filename:=既存ファイル名 oXLS.ActiveWorkbook.Sheets(シート名).Copy Set NewBook = oXLS.ActiveWorkbook oXLS.Workbooks(ファイル名).Close 複数シートがある場合の作成方法を教えてください。よろしくお願いします。

life0305
お礼率13% (11/79)

Visual Basic
回答数1
ありがとう数1

みんなの回答 （1）
専門家の回答

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

ベストアンサー

pen_pen_pen
ベストアンサー率65% (52/79)

2005/11/29 22:27 回答No.1

Dim oXLS As New Excel.Application Dim NewBook As Excel.Workbook Set NewBook = oXLS.Workbooks.Open(既存ファイル名) NewBook.SaveAs ファイル名 NewBook.Close でファイル丸ごと別名で保存する＝コピーを作ったことになります。全てのシートを新規のブックに作るには、 oXLS.ActiveWorkbook.Sheets.Copy Set NewBook = oXLS.ActiveWorkbook oXLS.Workbooks(ファイル名).Close でできます。また、何もせずにファイルを閉じるのであればEXCELを起動してコピーとせずにただのファイルのコピーでも良いかと思います。 FileCopy 既存ファイル名, ファイル名

質問者

お礼 2005/11/30 09:50

全てのシートを新規ブックに作る方法でできました。ありがとうございました。

関連するQ&A

VBAであるBOOKの「sample」というシートを別BOOKに
VBAであるBOOKの「sample」というシートを別BOOKに別Bookにコピーしたいのですが、ネットを参考にして下記のようにするとエラーになります。実行時エラー'9' 「インデックスが有効範囲にありません」と表示されます。どこが間違っているでしょうか？　どなたか教えてください。 ---------------------------------------- Dim NewBook As Workbook Dim fName As String Set NewBook = Workbooks.Add fName = ThisWorkbook.Path & "cp.xls" NewBook.SaveAs Filename:=fName Workbooks("moto.xls").Sheets("ピッキング").Cells.Copy Workbooks(fName).Sheets("Sheet1").Paste Destination:=Cells(1, 1) '<---ここでエラー Workbooks(fName).Save ----------------------------------------
- ベストアンサー
- Visual Basic
保護されたブックのコピーについて
現在、ボタンを押すと新規ブックが作成され、最初のブックのシートをコピーするというマクロを組みました。しかし、元になるブックにはブックの保護とシートの保護を両方かけていて、途中でエラーになるはずなのですが、何故かそうならずに普通に新規ブックにコピーがされます。上手くいったのですがエラーが出ると予想していたので気持ちが悪く、また個人だけで使うわけじゃないので原因を知っておきたいです。どなたかよろしくお願いします。 Private Sub makeBookButton_Click() Dim myWorkBook As String Dim newWorkBook As String Dim mySheet As Worksheet Application.ScreenUpdating = False On Error GoTo ErrTrap Application.DisplayAlerts = False myWorkBook = ThisWorkbook.Name Workbooks.Add ActiveWorkbook.SaveAs Filename:=NEWBOOK newWorkBook = ActiveWorkbook.Name Workbooks(myWorkBook).Activate For Each mySheet In ThisWorkbook.Worksheets Workbooks(myWorkBook).Sheets(mySheet.Name).copy after:=Workbooks(newWorkBook).Sheets(Workbooks(newWorkBook).Sheets.Count) Next Workbooks(NEWBOOK).Sheets("Sheet1").Delete Workbooks(NEWBOOK).Sheets("Sheet2").Delete Workbooks(NEWBOOK).Sheets("Sheet3").Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Exit Sub ErrTrap: Call MsgBox("ブック作成時にエラーが発生しました。", vbCritical) End Sub
- 締切済み
- Visual Basic
エクセルVBAでのエラー
おはようございます。昨日ここでいろいろ教えていただき、300のエクセルファイルから特定の範囲のデータ抽出方法を書いてみたのですが、セルが多すぎて実行できません、というエラーがでてしまいます。これはどのように解消すればよろしいのでしょうか？ Sub Test() Dim FPath1 As String, FPath2 As String Dim FName As String, myBook As String Const startROW As Long = 14, lastROW As Long = 20 Const startCOL As Long = 8, lastCOL As Long = 10 Const shtNAME As String = "sheet1" Application.ScreenUpdating = False FPath1 = "D:\MR5567\" FPath2 = "D:\New Microsoft Excel Worksheet\" Workbooks.Add myBook = ActiveWorkbook.Name FName = Dir$(FPath1 & "*.xls") Do While FName <> "" Workbooks.Open Filename:=FPath1 & FName ActiveWorkbook.Sheets.Select Sheets(1).Activate Sheets.Copy After:=Workbooks(myBook).Sheets(Sheets.Count) Workbooks(FName).Activate Application.DisplayAlerts = False ActiveWorkbook.Close FName = Dir$ Loop ActiveWorkbook.SaveAs Filename:=FPath2 & "Renketsu.xls", FileFormat:=xlNormal ActiveWorkbook.Close Application.ScreenUpdating = True End Sub
- ベストアンサー
- オフィス系ソフト
Excel VBA連続コピー、貼付処理について
特定のフォルダ内に格納されている複数のExcelファイルの「sheet1」シートのデータを所定のExcelファイルにコピー＆ペーストしたいのですが、うまくいきません。（貼付先のファイルを閉じようとするとエラーが発生します。）どうすればできるようになるでしょうか? ご教授の程よろしくお願いいたします。 -------------------------------------------------------------------- Sub copy_test() Dim myPath As String Dim copyFile As String Dim pasteFile As String Dim n As Long myPath = "C:\copy\" copyFile = Dir(myPath & "*.xls*") pasteFile = "C:\paste\paste_data.xlsx" n = 2 Do Until copyFile = "" Workbooks.Open Filename:=myPath & copyFile Workbooks(copyFile).Worksheets("sheet1").Range("A2:L201").Copy Workbooks.Open Filename:=pasteFile 'Workbooks(pasteFile).Worksheets("paste_data").Active Range("B1").Select Selection.End(xlDown).Select Selection.End(xlToLeft).Select Selection.End(xlUp).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste ActiveWorkbook.Save Workbooks(pasteFile).Close False Application.CutCopyMode = False Workbooks(copyFile).Close False n = n + 999 copyFile = Dir() Loop End Sub ---------------------------------------------------------------------------------
- ベストアンサー
- その他(業務ソフトウェア)
VBAで　Set wb = Sheets(1).Copyができないわけ？
つい先ほどの質問　4150169　は掲示したコードが抜けておりましたので無視して、こちらにご回答ください。ほんと抜けた話です。すみません。以下のマクロtest01はエラーになります。 Sub test01() Dim wb As Workbook Set wb = Sheets(1).Copy 'エラー「オブジェクトが必要です」 End Sub もちろん Dim wb As Workbook Sheets(1).Copy Set wb = ActiveWorkbook と修正すればエラーにならないことは存じていますが、ふと疑問がわきました。 Sheets(1).Copyの段階であたらしいWorkbookが誕生していますよね。ならば、そのWorkbookはオブジェクトではないのでしょうか？ Workbooks.Add　で誕生したWorkbookは Set wb = Workbooks.Add と変数wbにSetできるのに Set wb = Sheets(1).Copy ができないのが不思議です。 Set wb = ActiveWorkbook としないでもSheets(1).CopyをwbにSetする書き方はないのでしょうか？
- ベストアンサー
- オフィス系ソフト
VB2005でExcelのシートをコピー
VB2005Expressで開発をしています。 Excelのシートをコピーして同じbookに追加をしたいと思っています。下記でまずExcelを使用できるようにして　Dim xlApp As New Excel.Application 　Dim xlBooks As Excel.Workbooks = xlApp.Workbooks 　Dim xlBook As Excel.Workbook = xlBooks.Add '新規のファイルを開く　Dim xlSheets As Excel.Sheets = xlBook.Worksheets 　Dim xlSheet As Excel.Worksheet = xlSheets.Item(1) 　xlApp.Visible = True 下記で追加できると思うのですが、()内にセットするパラメータがわかりません・・・　xlBook.Worksheets.Copy() どなたかご存知の方がいらっしゃいましたら教えて下さい。よろしくお願いします。
- ベストアンサー
- Visual Basic
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　シート保存ボタン
Sheet上にボタンを作成ボタンを押すと保存するようにしています！以前ここでSheet2枚をコピー出来るような記述教えてもらったのですが・・ 1枚ならどう変化して良いか・・記述を書きましたが何処が違うか教えて下さい！ Private Sub CommandButton1_Click() 　　Dim FileName　　As String 　　Dim FileExt　　 As String 　　Dim BkName　　　As String 　　Dim OldWkbook　 As Workbook 　　Dim NewWkbook　 As Workbook 　　Const StName1　 As String = "ko" 　　　　' 　　Application.DisplayAlerts = False 　　Set OldWkbook = ActiveWorkbook 　　' 　　'ファイル名を取得　　BkName = OldWkbook.Sheets(StName1).Range("A1").Value 　　FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" 　　' 　　FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) 　　If FileName = "" Then 　　　　Exit Sub 　　Else 　　　　If Right(FileName, 4) <> ".XLS" Then 　　　　　　MsgBox "ファイル名が異常です。" 　　　　　　Exit Sub 　　　　End If 　　End If 　　' 　　OldWkbook.Sheets(Array(StName1)).Copy 　　Set NewWkbook = ActiveWorkbook 　　For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count 　　　　NewWkbook.Sheets(1).Shapes(wIx).Delete　　　Next 　　NewWkbook.Sheets(1).Name = StName1 　　' 　　FileName = "D:\保存\計画\" & FileName 　　' 　　If Dir(FileName) <> "" Then 　　　　'##ファイルが既に存在する　　　　If MsgBox("既に指定のファイルが存在します。置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then 　　　　　　NewWkbook.Close savechanges:=False 　　　　　　'##保存せずに終了　　　　　　Exit Sub 　　　　End If 　　　　'##指定ファイル置き換え保存　　　　NewWkbook.SaveAs FileName:=FileName 　　Else 　　　　'##ファイルを新規保存　　　　NewWkbook.SaveAs FileName:=FileName 　　End If 　　' 　　NewWkbook.Close savechanges:=False 　　Application.DisplayAlerts = True End Sub 教えて下さい！
- ベストアンサー
- オフィス系ソフト
VBAの質問です。（初心者です。。。）
VBAの質問です。（初心者です。。。） ”作成ファイル”には複数のシート（時系列）があり、それぞれのシートに縦（ラベルA）、横（ラベルB）のデータ値が入っています。それをVBAによって、シート（ラベルA）、縦（時系列）、横（ラベルB）となる新しい”リスク分析”ファイルを作成します。現在出るエラーは「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」です。実行すると”リスク分析”ファイルを新たに作成するところまではできているのですが、そこから新しいシートを追加する前で止まっています。（そのあたりで間違いいがあると考えられます。）考えられる原因を教えていただけないでしょうか。以下プログラム Sub riskfile() Dim ddd As Long ddd = Format(Date, "yyyymm") Dim ttt As Long ttt = Format(Time, "hhnnss") Dim Newbook As Workbook Set Newbook = Workbooks.Add Newbook.SaveAs Filename:="リスク分析" & ddd & ttt Workbooks("作成ファイル").Worksheets(2).Activate Dim span As Integer span = Workbooks("作成ファイル").Sheets.Count - 1 '作成ファイルのシート数（時系列） Dim month As Integer Dim portfolio As Integer For portfolio = 1 To 16 '新しいシートを追加し、シートに名前（ラベルA）を定義 Dim portname As String portname = Workbooks("作成ファイル").Worksheet(2).Cells(portfolio, 3) 'ラベルAの名前を定義 Workbooks("リスク分析" & ddd & ttt).Activate Dim NewWS As Worksheet Set NewWS = Workbooks("リスク分析" & ddd & ttt).Worksheets.Add(before:=Worksheets("Sheet1")) NewWS.Name = portname For month = 1 To span '作成ファイルの時系列シートから各ラベルAのデータ行を抽出し、リスク分析ファイルのラベルAシートへ貼り付け Workbooks("作成ファイル").Worksheet(month).Range(portfolio & ":" & portfolio) _ .Copy Destination:=Workbooks("リスク分析" & ddd & ttt).Worksheet(1).Range(month & ":" & month) Next month Next portfolio End Sub
- ベストアンサー
- Visual Basic
エクセルVBA　ブック間のコピー
選択したテキストファイルをエクセルで開いたコピーし、もう一つ開いたエクセルファイルにペーストするというマクロをVBAで作成していますが、つまずいてしまいました。 ----------------------------------- Dim wb1 As String Dim wb2 As String Sub Opentxt() wb1 = Application.GetOpenFilename("テキストファイル,*.txt") If wb1 <> "False" Then Workbooks.OpenText Filename:=wb1, DataType:=xlDelimited, comma:=True End If End Sub Sub Copy() Dim LastRow As Long wb2 = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") If wb2 <> "False" Then Workbooks.Open wb2 LastRow = wb2.Sheets("一覧表").Range("A" & Rows.Count). End(xlUp).Row wb2.Sheets("一覧表").Range("A5:A" & lastRow).Copy _ wb1.Sheets("Sheet1).Range("B33") End If End Sub ----------------------------------- Opentxtの方は問題ないですが、Copyの方を実行すると wb1とwb2で引っかかって「コンパイルエラー/ 修飾子が不正です」と表示されて、エラーになってしまいます。この場合変数の型などがおかしいのでしょうか？ excel2007を使用しています。よろしくお願いします。
- ベストアンサー
- Visual Basic