- ベストアンサー
ファイル間のシートコピー（Match関数とArray）
- Excel VBAで異なるファイル間で特定のシートをコピーする方法を解説します。
- マクロ実行ファイルBでAのデータを使用するため、Aファイルの一部のシートをBファイルの同名のシートにコピーする必要があります。この記事では、Match関数とArrayを使用して特定のシートを見つけ、データをコピーする方法を紹介します。
- ExcelのVBAを使用して、一部のシートを異なるファイルにコピーする方法を解説します。マクロ実行ファイルBではAファイルのシートデータが必要であり、そのためにAファイルの特定のシートをBファイルの同名のシートにコピーします。Match関数とArrayを使って特定のシートを探し、データをコピーする手順を説明します。
- 247_goo
- お礼率75% (3/4)
- Visual Basic
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- エクセルVBA【ワークシートのコピー】について
以下のVBA記述で、とあるエクセルファイルのシートをCSV化しようとしております。記述の場合、すべてのワークシートが対象となっていますが、１０個くらいあるWorkSheetの【sheets(8)】のみを対象としたいのですが、どのようにしたら良いのでしょうか？ お手数ですがご教授下さい。 Sub test() Dim sh As Worksheet Dim fname As String Application.ScreenUpdating = False For Each sh In ActiveWorkbook.Worksheets fname = "C:\temp\" & sh.Name & ".csv" sh.Copy With ActiveWorkbook .SaveAs Filename:=fname, FileFormat:=xlCSV .Close savechanges:=False End With Next sh Application.ScreenUpdating = True End Sub
- ベストアンサー
- オフィス系ソフト
- ファイル すべてのシート 値だけ 別のシート
ファイルAのすべてのシートに関数式が含まれています。 このシートを別フォルダーに分割し書き出すことは出来たのですが 関数式まで貼り付けられます。 これを値のみにしたいのですがご教授御願いします。 マクロはこれです。 Sub シート分割() Const path As String = "C:￥" Dim bk As Workbook Set bk = ActiveWorkbook Dim st As Worksheet For Each st In bk.Sheets Workbooks.Add st.Copy Before:=ActiveWorkbook.Sheets(1) ActiveWorkbook.SaveAs path & st.Name & ".xls" ActiveWorkbook.Close Next 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セルから指定できるようにしたいです。 宜しくお願いします。
- ベストアンサー
- Visual Basic
- 複数のファイルの、複数のシートにあるD9セルの数字を、新しいブックにリ
複数のファイルの、複数のシートにあるD9セルの数字を、新しいブックにリストしたいのですが、上手くいかないようです。 以下、それらしきマクロのコピペです。 （使用ソフトはエクセル2003です） Sub sample() Dim folder As String Dim sh As Worksheet Dim file As String Dim r As Long folder = "C:\abc\M1501～M2140\" 'ファイルがあるフォルダ sh.Range("A1").Value = "ファイル名" '見出し sh.Range("B1").Value = "A1" '同上 r = 2 '結果出力行の初期値 file = Dir(folder & "*.xls") 'フォルダ内の最初の.xlsファイルを取得 Do While file <> "" 'ファイル名がある間 Workbooks.Open folder & file 'そのファイルを開く sh.Range("A" & r).Value = file '結果シートのA列にファイル名を sh.Range("B" & r).Value = ActiveWorkbook.Sheets("あいうえお").Range("D9") '結果シートのB列に開いたブックのあいうえおのD9の値 ActiveWorkbook.Close False '開いたブックを閉じる r = r + 1 '結果出力行+1 file = Dir '次のファイル名取得 Loop '繰り返す End Sub これですと、「あいうえお」のシートのD9しか結果表示されないようです（実際、これは複数ファイルからの抽出用です）。 この式に複数シート対応の式を加えれば出来そうな気がするのですが、ここからどうすればいいかわかりません； 上記の式を大幅変更でも構いませんので、教えて下さい。
- ベストアンサー
- オフィス系ソフト
- ファイルを開き、シートをコピーするマクロについての質問です。
VBA初心者の者です。解決法が分からないのでよろしくお願いします。 以下のことがマクロを用いて行いたいと思ってます。 (1)まず、シート1からｎまであるデータの入ったファイル【以下、ファイル1】を指定して開き、それを別のシート1からｎまであるファイル【以下、ファイル2】を指定して開きます。 (2)ファイル１の各々のシートからファイル２のおのおののシートにデータをコピーしたいと思っています。ただし、コピーするのは、ファイル１のシート1からファイル２のシート１、ファイル１のシート２からファイル２のシート２に、・・・、ファイル１のシートｎからファイル２のシートｎまでループさせたいです。 一応、自分で以下のようにマクロを組んでみましたが、上手く動きません。どこが違うのかをご指摘いただきたいです。 よろしくお願いします。 Public sh As Integer Public sht_n As Integer Public Lst As Integer Sub Macro1() Dim file1 As String file1 = Application.GetOpenFilename(Title:="ファイルを選択して下さい") If file1 = "" Or file1 = "false" Then MsgBox "ファイルOPEN不可", vbCritical End Else Workbooks.Open Filename:=FN1 End If Dim file2 As String file2 = Application.GetOpenFilename(Title:="ファイルを選択して下さい") If file2 = "" Or file2 = "false" Then MsgBox "ファイルOPEN不可", vbCritical End Else Workbooks.Open Filename:=FN2 End If sht_n = ActiveWorkbook.Sheets.Count Lst = sht_n + 1 For sh = 1 To sht_n Call CpSh(sh) Next sh End Sub Sub CpSh(s) Dim st As String st = Sheets(s).Name Sheets(st).Select Workbook("FA1").Activate Sheets("st").Select Cells.Select Selection.Copy Workbook("FA2").Activate Sheets("st").Select Range("A1").Select ActiveSheet.Paste End Sub
- 締切済み
- オフィス系ソフト
- ExcelシートをCSVファイルにする
Excel2000を使用してます。 Excelブックに３つのシートがあります。 シート１はメインシートとして「ボタン1」「ボタン2」が存在してます シート２はインプットデータ用シート シート３はアウトプットデータ用シートです シート１の「ボタン1」を押すとVBAが実行されシート２の情報を読み、 シート３に算出結果を出力する仕組みです。 次にシート１の「ボタン2」を押すとシート３の内容をCSVに出力したいのですが、 下記のロッジクではうまくいきません。 どこを修正すればよいのでしょうか？ Sub CSV出力() Dim ONAME As String Dim しーと As Worksheet Dim 新しーと As Worksheet Dim PAS As String 'OUTパス名 PAS = ThisWorkbook.Path ONAME = PAS & "\" & "出力.CSV" '出力しーと Sheets("出力").Select Set しーと = ActiveSheet Set 新しーと = Worksheets.Add With 新しーと しーと.Copy .Move End With With ActiveWorkbook .SaveAs Filename:=ONAME, FileFormat:=xlCSV .Close False End With End Sub
- ベストアンサー
- その他（プログラミング・開発）
- 【マクロ】エクセル 複数のsheet ファイル分け
いつもお世話になります。 エクセル2003で、下記記述のマクロにて、 一つのファイルにまとまった３つのsheetを個別の ファイルにするよう、使用してました。 エクセル2013でもこのマクロは利用できるのですが、 xlsでなく、xlsxで作成されてしまうため、 どのようにこのマクロを書き変えると、xlsで実行される ようになりますでしょうか。 この記述以外でも問題ございません。 どうか、どなたかお知恵を拝借できると幸いです。 マクロ－－－－－－－－－－－－－－－－－－－－－－－ sub macro1() dim s as worksheet for each s in worksheets s.copy activeworkbook.saveas s.name activeworkbook.close false next end sub －－－－－－－－－－－－－－－－－－－－－－－－－－
- ベストアンサー
- Excel（エクセル）
- Ｍａｔｃｈ関数がうまく機能していない？？
すみません。また教えて下さい。 過去ログを見てシート１にあったデータをシート４にあるデータと照らし合わせてすでにあれば書き換え、なければ追加というようにできるようにしたく過去ログを参考にしてやったのですが、どうしてもエラーが出てしまいます。 Private Sub aa() Dim intlastrow1 As Integer Dim strb As String Dim longlastrow1 As Long intlastrow1 = Sheets(1).Range("A7").End(xlDown).Row longlastrow1 = Sheets(4).Range("A1").End(xlDown).Row Dim c As Object Dim rtn As Variant Dim d As Integer With Sheets(4) .Select For Each c In .Range("A1", "A" & longlastrow1) rtn = Application.Match(c.Value, Sheets(1).Range("A7:A" & intlastrow1), 0) d = c.Row strb = Cells(d, "A").Value If IsError(rtn) Then With Sheets(4).Cells(longlastrow1 + 1, "A") .Value = strb With .Font .Name = "ＭＳ Ｐゴシック" .Bold = False .Size = 8 End With End With Sheets(4).Cells(longlastrow1 + 1, "B").Value = Sheets(1).Range("A2").Value Sheets(4).Cells(longlastrow1 + 1, "F").Value = ShowFormula(Sheet1.Range(Cells(d, "J"), Cells(d, "N"))) longlastrow1 = longlastrow1 + 1 End If If Not IsError(rtn) Then Exit Sub End If Next c End With End Sub 以上のように組んだのですがうまくいきません。 具体的に言うとシート１のＡ７よりしたに名前が並んでいる（山田、鈴木・・・）とお考え下さい（シート４のＡ２以下にも同様に名前が並んでいる）。字数の関係で判定後の処理が不十分になっています。
- ベストアンサー
- オフィス系ソフト
- ファイル名を変更後、コピーができない
いつもお世話になります。 システムからダウンロードしたファイルを「東海」に変更して、H、AR、AS列にあるデーターを 「集計表」のN、O、P列に貼り付けしたいのですが、データーはあるのに、そのデーターが張り付きません。 どこが間違っているのか教えてください。よろしくお願いします。 「集計表」は、別の地域のデーターがN：Pに入っていいます。 Ａ：Ｌは、市町村ごとに集計したデーターが入っています。 「東海」にファイル名を変更したのは、一度に貼り付けできなかったからです。 ファイル名を変更しなくても、「集計表」に貼り付けできたらうれしいです。 Sub 東海登録状況() Dim t As Long Dim i As Long Dim bk As Workbook Dim bk1 As Workbook Dim sh As Worksheet Dim sh1 As Worksheet 'ブック名の変更 ActiveWorkbook.SaveAs Filename:="東海.xls" ← この場所に「東海」とうファイルが 存在します。置き換えますか？ という表示がでます。 Set bk = Workbooks("東海.xls") Set sh = bk.Worksheets(1) Set bk1 = Workbooks("集計表.xlsx") Set sh1 = bk1.Worksheets(1) 'シート名の変更 sh.Name = Format(Now, "mmdd") t = sh.Range("A" & Rows.Count).End(xlUp).Row i = sh1.Range("P" & Rows.Count).End(xlUp).Row '必要な列を選択する sh.Range("H2:H" & t).Copy Destination:=sh1.Range("N" & i + 1) sh.Range("AR2:AS" & t).Copy Destination:=sh1.Range("O" & i + 1) End Sub
- ベストアンサー
- Excel（エクセル）
- 【VBA】Ifで他シートから検索しコピーする
Excel vbaについて教えてください。 自分で作成したコードが、うまく動かず悩んでいます。 ●作りたいもの Sheet3のA列にある数字を検索値とし、 Sheet1のA列を検索し、合致する行のB列～最終列までコピーし、 Sheet3のB列から貼付する。 ※Sheet1にある列数（項目数）は不定です ●作成したマクロ Sub test() Dim sh1 As WorkSheet Dim sh2 As WorkSheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet3") d = sh2.Range("A1").End(xlDown).Row 'Sheet3検索値のA列のデータの最終行 g = sh1.Range("B1").End(xlToRight).Column 'Sheet1の最終列 k = 2 For i = 2 To d 'Sheet3最終行まで If sh1.Cells( i & "A") = sh2.Cells( 1,"A") Then '条件）Sheet1とSheet3のA列が合致 For j = 2 To g 'Sheet1の最終列まで sh2.Cells( k , j ) = sh1.Cells( i , j ) 'Sheet1のB行から最終列をコピーしSheet3へ貼付 Next j End If Next End Sub いろいろ直していたのですが、Set sh2 = Worksheets("Sheet3")で「インデックスが有効範囲にありません」（同じブック内に同名シートがあるのに？）とエラーが出たり、 また、B行から最終列までコピーする際の範囲指定についてもよくわからず、 もっと他に良い方法が無いものかとお手上げ状態です。 どうぞ宜しくお願いいたします。
- 締切済み
- Visual Basic
お礼
お礼が遅れて本当に申し訳ありませんでした。 回答をありがとうございました。 シートのテキストが大きすぎるのＰＣが固まってしまうため 実現できませんでしたが、勉強になりました。