- ベストアンサー
他のブックからシートを自ブックに取り込む方法
hige_082の回答
- hige_082
- ベストアンサー率50% (379/747)
＃２の補足読みました 最初の質問と違う内容の質問になる場合は 一度閉じて再質問してくださいね Sub test() Dim st As Worksheet Application.DisplayAlerts = False For Each st In Worksheets If InStr(st.Name, "月分") > 0 Then st.Delete End If Next Application.DisplayAlerts = True End Sub このマクロに関して補足等がある場合は再質問でお願いします
関連するQ&A
- ブックＣｌｏｓｅでＶＢＡが続かない
エクセル２００２を使用しています ブック（Ａ）をコピーして名前（Ｂ）をつけて別ブックで保存しました ブック（Ａ）を呼び出し後、ブック（Ｂ）を閉じてブック（Ａ）のＶＢＡを継続したいのですが 継続しません 作成したモジュールは以下です Application.DisplayAlerts = False '【不要なシートを削除する】 Sheets(Array("注文書入手差異表", "入手予定履歴", "main", "営C")).Select ActiveWindow.SelectedSheets.Delete '【ThisWorkbook.Pathの『注文書確認フォルダ』の中に、名前をつけて別ブックで保存する ' …ユーザーフォームを使用するのでマクロごと保存】 Dim myFolder As String Dim Filename As String myFolder = ThisWorkbook.Path & "\注文書確認フォルダ" Filename = Format(Date, "yyyymmdd") & "注文書入手予定表" If Dir$(myFolder, vbDirectory) = "" Then MkDir myFolder End If ActiveWorkbook.SaveAs Filename:= _ myFolder & "\" & Filename Application.DisplayAlerts = True '【保存した別ブック名を再取得】 Dim myName0 As String myName0 = ThisWorkbook.Name '【コピー元のファイルを開く】 Dim myPath As String myPath = Application.Substitute(ThisWorkbook.Path, "\注文書確認フォルダ", "") Workbooks.Open (myPath & "\" & "注文書入手予定表") MsgBox "【注文書確認フォルダ】の中に別ブックが作成されました" '【保存した別ブックを閉じる】 Workbooks(myName0).Activate Windows(myName0).Activate ActiveWorkbook.Close '******下のマクロが続かない***************** '====================== Call Macro6 '====================== VBA ステップインで原因を探ろうとしたのでですが 「中断モードでは入力できません」のメッセージがでて デバッグができません 八方ふさがりの状態です。助けていただけませんか。
- ベストアンサー
- オフィス系ソフト
- シートを他のブックに貼付けたい
Excel2007でマクロ作成中の初心者です。 やりたいことは 1）本ブックの中の「当月売上」シートを他ブックに貼付けたいです。 2）他ブックに貼り付けた「当月売上」シート名は、セルK1の日付に変更したいです。 すると、他ブックのシートが毎月順に、売上(2012年4月) 売上(2012年5月) 売上(2012年6月)というふうに増えます。 3）何月に作成しても、ブックの「当月売上」シートを貼り付けます。 四苦八苦して以下のコードをつくりましたが、「同じ名前のシート名に変更できません。」 というエラーがでるので、このエラーが出ないように、名前が同じ時は上書き保存し、違うときは新しいシート名を作るという コードにしたいです。困ってます。どうかご指導お願いします。 Sub 売上シートの貼付け() Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 貼付け先他ブック ChDir ThisWorkbook.Path + "\売上" On Error Resume Next Set WBK2 = Workbooks("24年度売上.xls") On Error GoTo 0 If WBK2 Is Nothing Then Set WBK2 = Workbooks.Open(ThisWorkbook.Path & "\売上\24年度売上.xlsm") End If Worksheets("当月売上").Copy After:=Workbooks("24年度売上.xlsm").Sheets(Workbooks("24年度売上.xlsm").Sheets.Count) ActiveSheet.Name = Format(Range("K1").Value, "売上(yyyy年mm月)") Application.DisplayFormulaBar = True WBK2.Close SaveChanges:=True Application.DisplayAlerts = True Set WBK2 = Nothing End Sub
- ベストアンサー
- Visual Basic
- ブックの集計方法について
複数ファイルにある特定のシートのA列に記載がある時だけ、その行のA列からJ列までを、一つのファイルにコピーしたいと思っています。 ネットで調べてみたところ、エクセルで複数ファイルにある特定のシートの 特定した範囲を一つのファイルにコピーするマクロを探すことができました。 複数のシートから特定のシートのA列に文字がある場合は、J列までを一つのファイルの同じシートにコピーするようなことは出来ないでしょうか？ （例えば、各ブックA列に10行ずつ文字がある場合は、このようなとりまとめをできないかと考えています。） ブック１（シート名：Q2）⇒集計シートのA１：J１０ ブック２（シート名：Q2）⇒集計シートのA１１：J２０ ブック３（シート名：Q2）⇒集計シートのA２１：J３０ Sub ブック集合() Dim FileName As String Dim c As Integer Dim OpenedBook As Workbook Dim IsBookOpen As Boolean ChDir "c:/test" FileName = Dir("*.xls") Application.ScreenUpdating = False Application.DisplayAlerts = False c = 0 Do While FileName <> "" If FileName <> ThisWorkbook.Name Then IsBookOpen = False For Each OpenedBook In Workbooks If OpenedBook.Name = FileName Then IsBookOpen = True Exit For End If Next If IsBookOpen = False Then Workbooks.Open (FileName) End If Workbooks(FileName).Sheets("Q2").Range("A1:J500 ").Copy _ ThisWorkbook.Sheets(3).Cells(c * 500 + 1, 1).PasteSpecial(xlPasteValues) c = c + 1 If IsBookOpen = False Then Workbooks(FileName).Close End If End If FileName = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
- ベストアンサー
- オフィス系ソフト
- 他のブックのマクロが見つらない。とのエラ－について
Excel VBAで、他のブックを開きそこのマクロを動かす事をしたいのですが、マクロが見つからないとのエラーが出ます。 'ファイル作成 Dim a As Variant Dim b As Variant a = Worksheets("sheet3").Range("e2").Value b = Worksheets("sheet3").Range("c2").Text ActiveWorkbook.SaveCopyAs Filename:=b & a & "-提出用作業表.xls" ActiveWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "\BackUp\" & b & a & "-提出用作業表.xls" Workbooks.Open Filename:=ThisWorkbook.Path & "\" & b & a & "-提出用作業表.xls" Application.Run b & a & "-提出用作業表.xls" & "!" & "提出用作業表シート削除" MsgBox "提出用作業表を作成したので、サーバーの所定の場所に保存提出して下さい" End Sub 変数が多く見にくくて申し訳ありません。上記のとおり記述したところ、対象ファイルが開くのですが「実行時エラー．１００４ マクロが見つかりません」とエラーが出ます。 しかし、エラーメッセージのなかに「'2006年12月社員1-提出用作業表.xls!提出用作業表シート削除'」と対象マクロが記述されてます。多分つまらないことを見落としているのではないかと思うのですが、理由がわかりません。ご教授お願いします。 対象マクロは、標準モジュール４に、Public Subで記載してます。This Wookbook内に記述してもだめでした。マクロの内容は、Sheetを１つ残して他を削除するというものです。 Application.Run Application.Run ThisWorkbook.Path & "\" & b & a & "-提出用作業表.xls" & "!" & "提出用作業表シート削除"でもだめでした。
- 締切済み
- Visual Basic
- ＥＸＣＥＬマクロ シートのありなし
EXCELのマクロでシートの存在を返す関数を作っています。 一応動くのですが、ブックをいちいちアクティブにしているのが 気に入りません。スマートな手法を教えて頂けませんか。 よろしくお願いします。 例） A.xls、B.xls、C.xls、D.xlsのように複数のブックが開かれています。 マクロは、マクロ.xlsというファイルに記述しているとします。 例えば、A.xlsというファイルにsheet4という名前のシートが存在するか調べたい。 Function isExistingSheetName2(Bookname As String, sheetname As String) As Boolean Dim wb As Workbook Dim ws As Worksheet Dim flag As Boolean Dim wbown As Workbook Dim wsown As Worksheet '現在を記憶 Set wbown = ThisWorkbook Set wsown = ActiveSheet '判定 Set wb = Workbooks(Bookname) wb.Activate ’←特に気に食わない For Each ws In Worksheets If ws.Name = sheetname Then flag = True Next ws '元に戻る wbown.Activate ’←気に食わない wsown.Select ’←若干気に食わない '戻り値 If flag = True Then isExistingSheetName2 = True Else isExistingSheetName2 = False End If End Function ’excel 2002 SP3 ’windowsXP Pro SP3
- ベストアンサー
- その他MS Office製品
- シートを複写して既にあるブックの中に挿入したい
Excel2007でマクロ作成中の初心者です。 現在下記のコードにより、自分のＰＣ、他のＰＣで正常に、マクロ実行しています。 1）このマクロは、年間１２個のブックができますので、加工が面倒です。そのため これを、デスクトップのフォルダ「実績綴り」内の、「年間集計表」というブックの 最前列のシートの前に追加していきたいのです。そうすれば、１年分がひとつのブックに 保存されるので何かと便利です。 3）追加するシート名が、無いときは問題ないですが、既にある場合は、複製が挿入されるので 最新のシートと古いシートが混在してしまいます。何か工夫はないでしょうか 。以上よろしくご指導をお願いします。 ’-------------------------------------------- Sub シートの保存() ' 現在使用しているマクロコード ’1）ブックには、シートの名「月売上」がある。 ’2）このシートを複写して、新規ブックを作成する。 ’3）このシートの「月売上」セル「Ｒ４の値」を、新規ブック名とする。 ’4）保存先は、デスクトップのフォルダ「実績綴り」とする。 ’5）セル「Ｒ４の値」が変更されない限り、上書きされるので、データは常に最新である。 Application.ScreenUpdating = False '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 Worksheets("月売上").Select myDate = Range("R4").Value Set WBK1 = ThisWorkbook ' 本ブック ' 指定シートを新規ブックにコピーする Worksheets("月売上").Copy Set WBK2 = ActiveWorkbook strFileName = Format(myDate, "ge年m月度") & ".xls" Dim Path As String, WSH As Variant Set WSH = CreateObject("Wscript.Shell") Path = WSH.SpecialFolders("Desktop") & "\実績綴り" Set WSH = Nothing ChDir Path Application.DisplayAlerts = False WBK2.SaveAs "月売上" & strFileName, FileFormat:=XlFileFormat.xlExcel8 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
- ベストアンサー
- Visual Basic
- 最終保存日時の表示方法について
現在、下記のようなマクロで指定ディレクトリ内のフォルダ名を検索し、A3から下に標記 取得したフォルダ名の中にある「いろは.XLS」の「C9」の値をB3から下に標記 としております。「いろは.XLS」が必ずあるという前提でのマクロです。 Sub main() Const myPath As String = "D:\テスト\" Dim myFolder As String myFolder = Dir(myPath, vbDirectory) Dim r As Integer r = 3 Do While myFolder <> "" If myFolder <> "." And myFolder <> ".." Then If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then Cells(r, 1).Value = myFolder Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[いろは.XLS]Sheet1 '!R9C3") r = r + 1 End If End If myFolder = Dir Loop End Sub 今回、C3から下に”各フォルダ内の「いろは.XLS」の最終保存日時”を標記し、「いろは.XLS」がない場合、ファイル名だけ取得したいのですが、どのようにすれば可能でしょうか？ ExecuteExcel4Macroについてはファイルを開かないで操作するそうなのですが、サイトのコピペで造っていくしかまだ出来ない知識ですので、この形になっております。
- ベストアンサー
- その他MS Office製品
- 別のブックから、特定のシートを指定して他のブックを開くには
マクロ初心者です。 A.xlsと、B.xlsという2つのブックがあります。 B.xlsはこの時、閉じた状態です。 Aには1つのシートのみがあって、Bには日毎に追加されていく不特定数のシートがあります。 Aのブックのシート内のセル番地A1に、「aaa」と入力した場合、B内の「aaa」という名前のシート名を指定してB.xlsを開くマクロはどう書いたら良いのでしょうか。 頼りきりの質問になってしまって申しわけございません。 何卒宜しくお願い申し上げます。
- ベストアンサー
- オフィス系ソフト
- ExcelでBookを開くPasswordにエラーを出さないには
Sub Dim FileName As String FileName = "D:\集計表.xls" Dim Sheet_Name As String Dim Book_Name As String Workbooks.Open FileName:=FileName Sheet_Name = "Sheet1" Book_Name = ActiveWorkbook.Name Workbooks(Book_Name).Sheets(Sheet_Name).Select Range("A1").Select End Sub 上記の構文でBookを開く時に「Password」を要求して開くようにしています。 ただ、Passwordを間違えた時は「実行時エラー1004」とな、「デバック」するか「終了」するしかありません。 デバック」・「終了」をせずに再度Password入力に戻るにはどの様にすれば良いでしょうか。
- ベストアンサー
- オフィス系ソフト
- シートの自動追加を新規ブックで実行したい
こんばんは。 いつもお世話になっています。 営業月報を作成したいと思い、色々お知恵を借りながら試しています。 Sheet1：チームのメンバー表 Sheet2～3：名簿と目標値 Sheet4：月報の原版 このような構成のブックで、毎月Sheet1のメンバー表を書き換え（名簿ファイルから直接コピペでA1セルから下に向かってメンバーの名前）、 下記のマクロを実行してSheet4を複製しています。 今はこの追加を同じブック内で最後尾へどんどん追加しているのですが、複数のチームで共有する都合を考え、Sheet1にコピペしたメンバーの月報は新規ブックを自動で起こしてシートを追加したいと思っています。 ＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ Sub シート追加() Dim 追加シート名 As String Dim i As Integer For i = 1 To Sheets("Sheet1").Range("a1").End(xlDown).Row 追加シート名 = Sheets("Sheet1").Cells(i, 1).Value Sheets("Sheet4").Copy After:=Sheets(Sheets.Count) Sheets("Sheet4" & " (2)").Name = 追加シート名 Next End Sub ＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊ 現在使用しているマクロはこのような内容なのですが、新規ブックでシートの追加をするには、どのようにすればよいのでしょうか？ よろしく御教示をお願いします。
- 締切済み
- オフィス系ソフト
お礼
＞＃２の補足読みました ＞最初の質問と違う内容の質問になる場合は ＞一度閉じて再質問してくださいね 大変申し訳ございませんでした。 一度、質問を終了し、新たに質問をするよう気をつけます。 また、懇切丁寧なご回答を毎々、有難うございました。