• 締切済み

エクセル VBA シート名を別シートにコピー

早速の質問ですが エクセルVBAで シート名を別シートにコピーなのですが 10個のシートを順にシート名をコピー&ペーストしたいのです。 Dim aworkbook As Workbook Dim bworkbook As Workbook Set bworkbook = ActiveWorkbook Workbooks.Add Set aworkbook = ActiveWorkbook for i=1 to 10 bworkbook.Activate Worksheets(i).Select Application.CutCopyMode = False aworkbook.Activate Worksheets(i).Select ここに入る文章がわかりません Range("A1").Select next と以上な感じで作ってみたのですが どう貼り付けして良いかわからない状況です nextでまわす以上変数でなければだめなんでしょうけれども 構文が思いつきません。 皆様よろしくお願いいたします。

  • nanny
  • お礼率55% (72/129)

みんなの回答

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.2

Sub try2() Dim wb As Workbook Dim i As Integer Dim j As Integer Workbooks.Add Set wb = ActiveWorkbook For i = 1 To 10 j = wb.Worksheets.Count If j < i Then wb.Worksheets.Add After:=wb.Worksheets(wb.Worksheets.Count) End If ThisWorkbook.Worksheets(i).Cells.Copy wb.Worksheets(i).Range("A1") Next Set wb = Nothing End Sub

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

自ブックを別名で保存すればいいだけかと思いますが・・・ Sub try() ThisWorkbook.Worksheets.Copy End Sub これでも全てのワークシートを新規ブックにコピーするはずです。 ⇒保存とかは考慮してないですが。

nanny
質問者

補足

シートは15個以上あるうちの10個のみを保存したい状況です。 ですので別名保存ではだめな状況です。

関連するQ&A

  • VBAのコピー

    VBAのコピー Dim xls As New Excel.Application Dim wbk As New Excel.Workbook Dim sh3 As Worksheet Set sh3 = Worksheets("全") sh3.Activate sh3.Range("A1:Z65536").Select Selection.Clear Set wbk = xls.Workbooks.Open("\\***.***.*.***\管理\全データ抽出.xls") wbk.Worksheets("全").Activate 'ワークシートをアクティブにする wbk.Worksheets("全").Range("A1:Z65536").Copy 'コピーする 'ActiveSheet.Paste Destination:=Worksheets("全").Range("A1") '貼り付ける Worksheets("全").Range("A1").PasteSpecial Paste:=xlPasteValues wbk.Close SaveChanges:=False 'Worksheets("メイン").Cells(1, 1).Select を実行すると 『wbk.Close SaveChanges:=False』のところで クリップボードに大きな情報があります。・・・・ と言うメッセージがでて必ずとまってしまうのですが メッセージをでないようにしたいのですが 教えてください。お願いします。

  • EXCEL 別シートのコピー(3)

    こんにちは。 こちらで以前こちらで質問をさせていただき、EXCELの別ブックのシートからコピーをしています。 元のブックのコピーを作り、そこに入力してもらい、元のブックにコピーをしています。(同じフォルダに入れて) Private Sub CommandButton1_Click() Dim myBook As Workbook Set myBook = Workbooks.Open(ThisWorkbook.Path & "\コピー元ブック.xls")  with workbooks("コピー元ブック.xls").worksheets("シート名").usedrange workbooks("貼り付け先ブック.xls").worksheets("シート名").range(.address).value = .value end with end sub ここでブックがない場合、そのブックを飛ばしてあるブックだけコピーしたい場合は、どうしたらいいでしょうか。いろいろやってみましたが、コピーできませんでした。 教えてください。

  • 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

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

    ACCESS VBAで作成済みのExcelファイル (複数シートがあります)の コピーを作成し そのファイルでテーブルのデータを 出力したいと思っています。 シートが1つならできましたが シートが複数あるとできません。 できる方法を教えてください。 なおシートが一つの場合は、下記でできました。 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 複数シートがある場合の 作成方法を教えてください。 よろしくお願いします。

  • VBAでエクセルをシート名を気にせず読み込むには?

    ACCESS2000のVBAでエクセルを読んでいるプログラムを作成しています。 今までは、その受け取っているエクセルのシート名が固定だったのですが、次回からシート名が可変になります。そこで相談なのですが、シート名が可変でも読み込む方法はありますか。ちなみにシートは1つです。(インポート以外でお願いします。) 現在のコーディング例 一部抜粋 Dim wb As Workbook 'ワークブック Dim ws As Worksheet 'シート 'マスタのExcelファイルを開く Set wb = Workbooks.Open("test") Set ws = wb.Worksheets("SHEET1") <=ここが可変になります。 i = 0 Do Until IsEmpty(ws.Cells(StartRow + i, StoreNoCol)) nohindate = ws.Cells(StartRow + i, 2) '日 i = i + 1 Loop 宜しくお願いします。

  • 別ブックへシートコピーでシート名が違う名

    別ブックへシートコピーでシート名が違う名前でコピーされてしまします。 環境 : エクセル2010 windows7 home (1)WEBページからコピーしてきたねたを、貼り付けCSVにして保存したいのです。 (2)ユーザーフォームからフォルダに名前を付けてデスクトップにフォルダを新規作成します。 (3)で、CSVにしたファイルを上記新規フォルダ内に保存したいのです。 問題点: 新規ブックをAddしているのですが、シート名も元のブックからコピーできているはずが、指定している保存先の名前になってしまいます。(変換後CSVファイル)になってしまう。 本当は(変換)となるはずなんですが・・・その時、Beforeでシート1の左にくるはずが、なぜか上記間違った名前のシートのみになってしまいます。 あと、これをパスを替えてほかのXPのPCで走らせると、(1)でコピペしたねたが消えてしまいます。 (保存はできますがねたがないと・・・) 上記問題点を解決したいのでどなたかどうぞご教授ください。 構文 Private Sub CommandButton1_Click() Dim a As Object Dim b As String Set a = CreateObject("Scripting.FileSystemObject") b = "C:\Users\Owner\Desktop\" & Me.TextBox1.Value 'フォルダ作成 If MsgBox("入力内容に間違いはありませんか?", vbYesNo) = vbYes Then a.Createfolder b Else Me.TextBox1.SetFocus Exit Sub End If 'フォルダ作成 その中に CSV保存 Dim ws As String Dim oWbk As Workbook Set oWbk = Workbooks.Add ws = "変換" Workbooks("suzuki csv 変換.xlsm").Worksheets(ws).Copy Before:=oWbk.Worksheets("Sheet1") oWbk.SaveAs Filename:="C:\Users\Owner\Desktop\" & Me.TextBox1.Value & "\変換後CSVファイル.csv", FileFormat:=xlCSV, CreateBackup:=False oWbk.Close SaveChanges:=True Unload Me Workbooks("suzuki csv 変換.xlsm").Activate Columns("A:H").Select Selection.ClearContents Rows("1:3").Select Selection.Delete Shift:=xlUp Range("A1").Select Dim w As Workbook '全ての Book を保存する For Each w In Workbooks w.Save Next 'Excel を終了する Application.Quit 'Book を閉じる ThisWorkbook.Close False End Sub 作業途中で構文が荒れていますが、ご容赦ください。

  • VBAで複数シートを新たに作成したBookにコピー

    いつも大変お世話になります。動作環境は、WindowXPSP3、EXCEL2010です。10個の名前付きsheetがあります。Book.xlsmから新たにBook1.xlsxを作成してこのBook1.xlsxに1個のsheet名が「sheet1」を作成します。そして、Book.xlsmにある10個の名前付きsheetをBook1.xlsxに作成した一個のsheet1にコピーします。コピーの仕方は、Book.xlsmの一番左端のsheetから順番にBook1.xlsxに作成した1個のsheet1に下から上に向かってコピーしていきます。最終的には、10個の名前付きsheetが纏められます。後一つの条件は、一番最初にコピーするシートには4行目に項目書かれております。なので、一番最初にコピー4行目だけはコピーして、後は、5行目からコピーしたく、下記のマクロを作成しました。 Option Explicit Option Base 1 Public Sub シートの纏め() Dim i As Long Dim mySheetCnt As Long Dim mySheetName() As String Dim ws As Workbook Dim s As Worksheet '========================================================================== mySheetCnt = ThisWorkbook.Sheets.count ReDim mySheetName(1 To mySheetCnt) For i = 1 To mySheetCnt - 3 mySheetName(i) = Sheets(i).Name 'MsgBox "変数mySheetName(" & i & ")=" & mySheetName(i) Next i '========================================================================== Dim EffectiveRow As Long Dim EffectiveColumn As Long EffectiveRow = Range("B65536").End(xlUp).Row 'MsgBox "EffectiveRow = " & EffectiveRow & "" EffectiveColumn = Cells(4, 256).End(xlToLeft).Column 'MsgBox "EffectiveColumn = " & EffectiveColumn & "" '========================================================================== Dim Book1 As Workbook For i = 1 To mySheetCnt - 3 If mySheetCnt = 11 Then GoTo Label1 'MsgBox "mySheetName(i) = " & mySheetName(i) & "" 'MsgBox "デフォルトで" & Application.SheetsInNewWorkbook & "枚作成されます" Workbooks.Add Application.SheetsInNewWorkbook = 1 Sheets("sheet1").Select Book1 = ActiveWorkbook.Name Workbooks("Bookxlsm").Worksheets("mySheetName(i)").Range("B4:AF58").Copy _   Workbooks("Book1.xls").Worksheets("sheet1").Range("B4") ⇐ここで、実行時エラーが出ます。 Next i Label1: End Sub しかし、実行時エラーで止まってしまいます。もう、1週間格闘しております。どなたか、何卒ご教授して頂きたく、宜しくお願い申し上げます。

  • vba 特定の複数シートを別ファイルで保存。

    ブック内にA,Bと2つのシートがあり、ボタンをクリックすると特定の回数、シートAの情報が新規作成されたシートCにコピーされ、シートCとシートBの2シートが別ファイルとして保存される。という動きを繰り返したいのですが、 新規生成されるシートCだけを別ファイルで保存することまでは出来たのですが、シートBが追加できず困っています。 Sub 分割() Dim cpy As Range Dim pst As Range Dim path 'ファイルパス path = ActiveWorkbook.path Dim CopyWorkBook Dim CopyWorkSheet1 Dim CopyWorkSheet2 Dim Position(2,2) 'ここにはシートCを作成する際の情報が入っている。 '新規シートCを作成してシートAからデータをコピー。 For i = 1 To 2 Step 1 'とりあえず2シート作成する。 Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Position(i, 2) 'まずは、タイトル欄をコピー Worksheets("Sheet1").Activate Set cpy = Worksheets("Sheet1").Range("A2:Q2") Worksheets(Position(i, 2)).Activate Set pst = Worksheets(Position(i, 2)).Range("A2:Q2") pst.Value = cpy.Value '貼り付け End With 'シートを別名で保存 Set CopyWorkSheet1 = Worksheets(Position(i, 2)) Set CopyWorkSheet2 = Worksheets("シートB") CopyWorkSheet1.Copy ' CopyWorkSheet2.Copy ←これでシートBもコピーされるかと思いましたが、シートBが上書きされてしまう。 Set CopyWorkBook = ActiveWorkbook ActiveWorkbook.SaveAs path & "\" & Position(i, 2) & "xls", xlWorkbookNormal CopyWorkBook.Close Next End Sub 質問は2つあります。 (1)シートBも新規作成されたシートCと一緒に別ブックに保存したいのですが、どうすればいいでしょうか? (2)シートのコピーの動きがイマイチよくわかりません。 今の私の環境だと(ネットで調べた書き方ですが)、シートを別ブックにコピーする際、 Set CopyWorkSheet1 = Worksheets("シートA") CopyWorkSheet1.Copy Set CopyWorkBook = ActiveWorkbook となっていますが、Setで、コピー元のシートAの情報をCopyWorkSheet1にコピーしたあと、 CopyWorkSheeet1.Copy となっていますが、この意味がわかりません。 なぜ更にコピーしているのでしょうか?またこれで、別ブックにシートが追加されてる理由もわかりません。 また、この処理の後に、 Set CopyWorkBook = ActiveWorkbook と、ブックの情報をコピーしていますが、普通に考えると最初にブックの情報をコピーして別名のブックを生成しておく必要があるように思えるのですが、後でよい理由も分かりませんし、これだと、Activeのワークブックのシート情報も全部コピーされてしまう気がするのですが。。。 この辺が全然分かっていないので、解説頂けるか参考サイトを教えて頂けないでしょうか。 よろしくお願い致します。

  • エクセルの範囲のコピー

    はじめて質問させていただきます。 エクセルにおいてシートの範囲をコピーし、他のブックのシートにコピーする下記のVBAがうまくいきません。 「ActivateSheet.Paste」において「実行時エラー424;オブジェクトが必要です」とのエラーメッセージがでます。申し訳ございませんが、ご教示お願いいたします。 -------------------------------------------------- Dim SourceFile, TourceFile, SourceSheet, TargetSheet As String Dim i As Integer, k As Integer SourceFile = "Book1" TargetFile = "Book2" SourceSheet = "Sheet1" TargetSheet = "Sheet1" Workbooks(SourceFile).Sheets(SourceSheet).Activate Columns("A:F").Select Application.CutCopyMode = False Selection.Copy Workbooks(TargetFile).Sheets(TargetSheet).Activate ActiveSheet.Cells(1, 1).Select ActivateSheet.Paste Workbooks(SourceFile).Sheets(SourceSheet).Activate

  • Excel 2007 マクロ 別ブックのシートをコピーする方法

    Excel 2007 マクロ 別ブックのシートをコピーする方法 別ブックのシートをコピーして アクティブなブックのシートにコピーしたいと思います。 下記マクロを作成しました。 貼り付ける際に、クリップボードに保存するかどうか 聞かれるメッセージが表示されてうまくいきません。 またもっとシンプルな書き方があればアドバイスお願いします。 Sub 取り込み() Dim wb As Workbook Set wb = Workbooks.Open("\") Sheets("Sheet1").Select Cells.Select Selection.Copy ThisWorkbook.Activate ThisWorkbook.Sheets("特定").Select ActiveSheet.Cells(1, 1).Select ActiveSheet.Paste wb.Close End Sub

専門家に質問してみよう