• ベストアンサー

選択されているシートを移動したい

一定ではない複数のシートがあり、 そのうちの右端の１枚は必ず「ファイル集計」というシートになっています。 この、ファイル集計以外のシートを 新しいブックを作って移動させるにはどうしたらいいでしょうか。 あくまでもファイル集計は元のブックに残し それ以外のシートを移動させたいのです。 Sub 入力データを保存して閉じる() Dim ファイルナンバー As String Dim 保存指定フォルダ2 As String Dim mySht As Worksheet With Application .DisplayAlerts = False For Each mySht In Worksheets If mySht.Name <> Sheets("ファイル集計").Name Then mySht.Select False Next .DisplayAlerts = False End With ↑このようなかたちで、選択するところまでは出来たのですが それを新しいブックに移動させるのがうまくいきません。 ChDir "C:\計算\" & 保存指定フォルダ Activesheets.Move ActiveWorkbook.SaveAs Filename:=ファイルナンバー & "D.xls" Application.DisplayAlerts = False 　　ActiveWorkbook.Close end sub とすると、選択されているシートのうち１枚しか移動できないのです。 教えてください。

  • miz_k
  • お礼率35% (10/28)

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

  • ベストアンサー
noname#52504
noname#52504
回答No.2

質問文では 　Activesheets.Move となっていますが、もし、 　Activesheet.Move としているのであれば、 "Activesheet"プロパティは、「一番手前のシート」を返しますから、 おっしゃるように一枚しか移動しませんね。 「選択しているすべてのシート」を得るには"SelectedSheets"プロパティを使います。 未検証ですが、 　Activesheets.Move の部分を 　ActiveWindow.SelectedSheets.Move とすればご要望のように動作するのではないかと。

miz_k
質問者

補足

ありがとうございます。 SelectedSheets.Move だけではエラーがでてしまったので 困り果てていたのですが ActiveWindow.SelectedSheets.Move としたところ思ったとおりの結果が得られました。 助かりました！！

その他の回答 (1)

回答No.1

自動記録をしてみたでしょうか 初心者の時は　自動記録が参考になります Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select Sheets("Sheet3").Activate Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Move Activesheets.Move　はアクティブなので　今見ているシートのみになります 記録すると上のようになると思います 不要なところを省略して Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Move これなら3つ移動できます

miz_k
質問者

補足

ありがとうございます。 しかし選択するのは "一定ではない複数のシート"ですので この方法ではダメでした。 でも大変参考になりましした。 決まった数のシートを選択するには Arrayを使うのですね。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • シートだけを保存したいのですが？

    はじめましてマクロ初心者です。 検索しましたがわからなかったので、質問させていただきます。 保存をキャンセルすると新規ブックができてしまいます。 キャンセルした時に新規ブックを作りたくないのですが、教えてください。 Sub シート保存() Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか？", vbYesNo) If Answer3 = vbYes Then Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy Else MsgBox ("キャンセルしました。") End If 既定ファイル名 = Range("V8") 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名) If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else ActiveWorkbook.SaveCopyAs 保存ファイル名 End If End Sub よろしくお願いします。

  • Excelシート１シートのみを指定フォルダへ保存

    Excelのシート1のみを、本日の日付と名前の入ったセル（I7）を保存する時の名前にして指定したフォルダへ保存したいと思っています。 1、シートは本日の日付+I7セルに入っている値を名前にする。 2、フォルダはCではなくV:\○○\○○\○○\○○\○○\○○\○○に格納 3、シート1以外のシート2、シート3は保存せず閉じる 4、格納後○○に保存しました。と表示 試行錯誤し、下記のように記述してみたのですが、 Sub Macro1() 'Option Explicit Sub Sample() Dim xSheet As Worksheet Dim myFile As String Dim myName As String Set xSheet = ActiveSheet ThisWorkbook.Worksheets("シート名").Copy 'myName = ActiveWorkbook.Worksheets(1).Name 'myFile = ThisWorkbook.Path & "\" & myName & ".xls" myFile = ThisWorkbook.Path & "\" & xSheet.Range("I7").Value & ".xls" Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=myFile Application.DisplayAlerts = True ActiveWorkbook.Close End Sub 日付を指定して保存 Sub test() 　Dim Filename As String 　Filename = Format(Date, "yyyy年mm月dd日") & ".xls" 　ActiveWorkbook.SaveAs "C:\My Documents\" & Filename End Sub 日付とI7セルの名前を合せてブックの名前としたい場合どうVBEで記述すればいいのかわからないので詳しい方がおられましたら、 よろしくお願いいたします。 あまり詳しくないので、そのままコピーできるか、○○の部分を指定フォルダ名に変えてください。等の注釈を付けていただけると助かります。

  • ファイルサーバーからローカルフォルダーに移動したい

    下記のVBAはローカル環境でデータを同じフォルダーにCSVとして吐き出す事を目的に調べながら作ったのですが、運用の関係上ファイルサーバーへ置く事になってしまいローカルの「ダウンロード」フォルダーにに吐き出せないか色々試してみているのですが、どうしても分かりません。お知恵をいただければ幸いです。 宜しくお願い致します。 '現在開いているシートをCSVデータで保存する Public Sub call_RangeSaveCSV() Dim fPath As String Dim fName As String Dim rng As Range '現在開いているブック情報をファイル名にするため、変数に格納 fPath = ActiveWorkbook.Path & "\" fName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "csv" Application.DisplayAlerts = False '現在選択しているセル情報をrngに格納 Set rng = Selection '新規ブック作成→rngをA1にコピー→CSV保存→CSV閉じる Workbooks.Add rng.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs Filename:=fPath & fName, FileFormat:=xlCSV ActiveWindow.Close Application.DisplayAlerts = True End Sub

  • VBAでブック名の拡張子を除去してシートにコピー

    VBA初心者でコード作成で困っております。 下記の通りコードを組みましたが、シート名をブック名に変更して 保存したいのですが、このコードですと拡張子までついてしまいます。 拡張子を除去するためにはどうすればよいでしょうか？ アドバイス宜しくお願い致します。 Sub test() 'シート名の変更 Dim MyPath As String Dim MyFile As String Dim Wb As Workbook MyPath = "C:\TEST\" MyFile = Dir(MyPath & "*.xlsx") Do While MyFile <> "" Set Wb = Workbooks.Open(MyPath & MyFile) ActiveSheet.Name = ActiveWorkbook.Name Application.DisplayAlerts = False Wb.Save Application.DisplayAlerts = True Wb.Close (False) MyFile = Dir() Loop 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　シート保存ボタン

    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 教えて下さい！

  • OSがVistaのエクセル2007で作ったファイルがＸｐのエクセル２００３で読み取れない

    すいません。教えてください。 Vista PCエクセル2007で保存したファイルが、XP PCエクセル2003で見ると文字化けしてしまうのですが、どこがいけないのか教えてください。 Sub 保存シートの名前を付けて保存() ' シート保存 Macro '***このマクロは見積もり番号と件名を保存ファイル名にし保存します。*** Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか？", vbYesNo) If Answer3 = vbNo Then MsgBox ("キャンセルしました。") Exit Sub End If Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy 既定ファイル名 = Range("V7") 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel 97-2003ブック, *.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" ActiveWorkbook.Close (False) Else ActiveWorkbook.SaveCopyAs 保存ファイル名 ActiveWorkbook.Close (False) End If End Sub よろしくお願いします。

  • （VBA）特定のシートのみを名前を付けて保存

    Excel2003です。 数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。 この非表示の状態で保存するにはどのようにすればよいのでしょうか？ 【以下現在のコードです】 ------------------------------------------------ Sub 名前を付けて保存() '報告書を"名前を付けて保存" Sheets("報告書").Select Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant 既定ファイル名 = "報告書" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else With ThisWorkbook.ActiveSheet Workbooks.Add .Cells.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs 保存ファイル名, xlNormal ActiveWorkbook.Close False End With Sheets("報告書").Select Range("A1").Select MsgBox "報告書を作成しました。" End If End Sub ----------------------------------------------------

  • シートの複写をデスクトップのフォルダに挿入したい

    Excel2007でマクロ作成中の初心者です。 今正常に作動しているマクロコード「この計算シートの保存」をもとに 「この計算シートをデスクトップの決まったフォルダに挿入」としたいです。 どう変更したらいいかご指導お願いします。 ------------------------------------------- Sub この計算シートをデスクトップの決まったフォルダに挿入() ' 'Const cnsTITLE = "マクロなしブックの作成" 'Const cnsFILTER = "Excelワークブック (*.xls),*.xls" Dim xlAPP As Application Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 作成ブック（新規ブック） Dim strFileName As String Dim tblSH As Variant Dim lngLines As Long Dim myDate As String myDate = Range("AE4").Value 'Date = Format(Date, "ge年m月度") Set WBK1 = ThisWorkbook ' 本ブック ' この計算シートをデスクトップの「計算書庫」フォルダに挿入する　　 Worksheets("この計算シート").Copy Set WBK2 = ActiveWorkbook strFileName = Format(myDate, "ge年m月度") & ".xls" ChDir ThisWorkbook.Path + "\計算書庫"　'デスクトップの「計算書庫」フォルダに変更したい Application.DisplayAlerts = False WBK2.SaveAs "定期計算書" & strFileName, FileFormat:=XlFileFormat.xlExcel8 MsgBox "この計算書を　" & myDate & "　の名前でデスクトップの「計算書庫」フォルダに挿入しました。" Application.DisplayFormulaBar = True WBK2.Close False Application.DisplayAlerts = True Set WBK2 = Nothing MAKE_NEWBOOK_WO_MACROS_EXIT: Set WBK1 = Nothing Set xlAPP = Nothing End Sub ---------------------------------------------- Sub この計算シートの保存() ' 'Const cnsTITLE = "マクロなしブックの作成" 'Const cnsFILTER = "Excelワークブック (*.xls),*.xls" Dim xlAPP As Application Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 作成ブック（新規ブック） Dim strFileName As String Dim tblSH As Variant Dim lngLines As Long Dim myDate As String myDate = Range("AE4").Value 'Date = Format(Date, "ge年m月度") Set WBK1 = ThisWorkbook ' 本ブック ' この計算シートを新規ブックにコピーする Worksheets("この計算シート").Copy Set WBK2 = ActiveWorkbook strFileName = Format(myDate, "ge年m月度") & ".xls" ChDir ThisWorkbook.Path + "\計算書庫" Application.DisplayAlerts = False WBK2.SaveAs "計算書庫"" & strFileName, FileFormat:=XlFileFormat.xlExcel8 MsgBox "この計算書を　" & myDate & "　の名前で保存しました。" Application.DisplayFormulaBar = True WBK2.Close False Application.DisplayAlerts = True Set WBK2 = Nothing MAKE_NEWBOOK_WO_MACROS_EXIT: Set WBK1 = Nothing Set xlAPP = Nothing End Sub

  • VBA　シート指定とファイル名入力

    部署ごとに分割し、ブックで保存するコードです。 sheet名は「部署」です。 Sub macro1() Dim w As Worksheet Dim n As Long Dim r As Long Dim s As String Dim WSH As Variant Dim myPath As String Set w = ActiveSheet n = Worksheets.Count Application.ScreenUpdating = False On Error GoTo errhandle For r = 5 To w.Range("B65536").End(xlUp).Row s = w.Cells(r, "B") w.Rows(r).Copy Worksheets(s).Range("B65536").End(xlUp).Offset(1, -1) Next r On Error GoTo 0 Set WSH = CreateObject("Wscript.Shell") myPath = ActiveWorkbook.Path & "\1\" For r = Worksheets.Count To n + 1 Step -1 Worksheets(Worksheets.Count).Copy ActiveSheet.Columns.AutoFit ActiveWorkbook.SaveAs Filename:=myPath & ActiveSheet.Name ActiveWorkbook.Close False Application.DisplayAlerts = False Worksheets(Worksheets.Count).Delete Application.DisplayAlerts = True Next r w.Select Exit Sub errhandle: Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = s w.Rows(1).Copy Range("A1") w.Rows(2).Copy Range("A2") w.Rows(3).Copy Range("A3") w.Rows(4).Copy Range("A4") Resume Application.ScreenUpdating = True End Sub (1)sheet1にマクロ実行ボタンを配置し、部署seedにマクロ実行命令をする。 (2)sheet1のB2セルにファイル名を入力して、そのファイルに保存する。（例部署ファイル） (1)Dim w As Worksheets("部署")と変更したのですが、エラーが出ました。 (2)myPath = ActiveWorkbook.Path & "\部署ファイル\"　 　↑ これをsheet1のB2セルから指定できるようにしたいです。 宜しくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する