マクロ 新しく作ったブックをアクティブにする
マクロ初心者です。
マクロを使って同階層にあるファイルのアクティブのシートを
ひとつのブックにコピーして保存するマクロを作りたいと思ってます。
他の質問を参照して下記のコードを途中まで作成しました。
参照した質問では、
マクロの入っているブックにシートをコピーするようでしたが、
そうすると保存した時にマクロも保存されてしまうので
私なりに調べて、新しいブックにシートコピーするようにしましたが、
この記述の後、新しいブックをアクティブにする記述がわからず、
保存できなくなってしまいました。
ここまで終わるとマクロの入っているブックがアクティブになって終わります。
このあと新しく開いたブックをアクティブにして、
ブックのsheet1~3を削除して、名前をつけて保存したいのですが
開いたブックをアクティブにするマクロをご伝授ください。
あたらしくブックをつくるとbook1~・・・と名前が変わってしまうので
変数で名づけたいのですが、やり方が良くわかりませんのでよろしくお願いします。
何卒よろしくお願いします。
Sub consolid_test()
Dim shCnt As Integer
Dim Wb As Workbook
Dim i As Integer
Dim sh As Worksheet
Dim nSh As Worksheet
Dim fName As String
Dim ka As String
Application.ScreenUpdating = False '画面更新を一時停止
Application.DisplayAlerts = False
Set mb = Workbooks.Add '新しいコピー先ブックをmbとする。
myfdr = ThisWorkbook.Path
fName = Dir(myfdr & "\*.xls") 'フォルダ内のExcelブックを検索
Do Until fName = Empty '全て検索
If fName <> mb.Name Then 'ブック名がこのブックの名前でなければ
Set Wb = Workbooks.Open(myfdr & "\" & fName) 'そのブックを開きwbとする。
Wb.ActiveSheet.Copy After:=mb.Sheets(mb.Sheets.Count) 'コピーしてコピー先ブックの末尾に置く
ActiveSheet.Name = Range("B16") 'シート名の変更
ActiveSheet.Unprotect 'シート全体をコピーして値にする
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Wb.Close (False) '保存の有無を聞かずに保存しないで閉じる
N = N + 1 'ブック数をカウント
End If
fName = Dir 'フォルダ内の次のExcelブックを検索
Loop '繰り返す
・
・
・
・
No.5ベストアンサー
- 回答日時:
こんにちは。
こんな感じにすれば不要なブランクシートはできません。
シート名を変更する際の簡単なエラートラップはついで。
余談になりますけど、
> If fName <> mb.Name Then
は ThisWorkbook と比較した方が良いでしょう。そして統合したブック
の保存の際に同名ファイル確認して Save するか、保存作業はユーザー
に任せた方が良いと思います。
ご参考までに。
余談その2
Active にできないのは、Application.ScreenUpdating = False のせい
な予感。
Sub sample()
Dim wbSrc As Workbook
Dim wbDst As Workbook
Dim sFolderPath As String
Dim sFileName As String
Dim sFilePath As String
Dim fCopied As Boolean
Application.ScreenUpdating = False
Application.DisplayAlerts = False
sFolderPath = ThisWorkbook.Path
sFileName = Dir$(sFolderPath & "\*.xls")
fCopied = False
Do While Len(sFileName) > 0
sFilePath = sFolderPath & "\" & sFileName
' // マクロのあるブック以外とする
If sFilePath <> ThisWorkbook.FullName Then
' // ソースブックを開く
Set wbSrc = Workbooks.Open(sFilePath)
' // 進捗表示
Application.StatusBar = "Copy ... " & sFileName
DoEvents
' // シートのコピー
If wbDst Is Nothing Then
ActiveSheet.Copy
Set wbDst = ActiveWorkbook
fCopied = True
Else
ActiveSheet.Copy After:=wbDst.Sheets(wbDst.Sheets.Count)
End If
' // 可能ならB16の値でシート名変更、不可能なら適当な名前
On Error Resume Next
ActiveSheet.Name = ActiveSheet.Range("B16").Value
If Err Then
ActiveSheet.Name = "Sheet" & CStr(wbDst.Sheets.Count)
End If
On Error GoTo 0
' // 値に変換(適当)
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
' // ソースブックを閉じる
wbSrc.Close SaveChanges:=False
End If
' // 次を検索
sFileName = Dir$()
Loop
Application.ScreenUpdating = True
Application.StatusBar = ""
If Not fCopied Then
MsgBox "該当ブックは見つからない", vbInformation, "エラー"
Else
MsgBox "適切な場所へ保存して下さい", vbInformation, "完了"
End If
Set wbSrc = Nothing
Set wbDst = Nothing
End Sub
大変勉強になりました!
もともとの構文自体もほかの質問から持ってきたものを
自分でここだと思われるところを適当に直しただけで、
何が悪かったのかさっぱりわかりませんでした・・
今回ご指南いただいたマクロを元に、勉強したいと思います。
本当にありがとうございました。
No.4
- 回答日時:
提示のコードのとおりであれば、
mb.Activateができないのはちょと不可思議な現象ですが、、、
エラーも出ないのですよね?
ま、そこに拘っていては先に進みませんので。。。。
下記のように、新ブックオブジェクトを明示してみてください。
mb.Activateは不要です。
'--------------------------------------
mb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Application.DisplayAlerts = False
Windows(mb.Name).SelectedSheets.Delete
Application.DisplayAlerts = True
mb.SaveAs myfdr & "\Consolidated.xls"
mb.Close False
'--------------------------------------
また、ブック名を変数で付けたい場合は、
例えば、統合&本日: "統合20090609.xls"
としたければ、
'---------------------------------------
Dim NewBookName As String
NewBookName = "統合" & Format(Date, "yyyymmdd") & ".xls"
mb.SaveAs myfdr & "\" & NewBookName
'----------------------------------------
以上ここまで。
お助けいただき、ありがとうございます。
みなさまのおかげで無事解決しました。
また分からないことが発生しましたら質問させていただきます!
No.3
- 回答日時:
n-junです。
止まるというのがエラーなのかよく分かりませんが、削除に対してのメッセージなら
mb.Activate
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
メッセージが出ないようにするとか?
この回答への補足
説明文がつたなくてすみません。
mb.Activate
この命令でマクロが動いてくれないのです。。
なぜだか見当もつきません。
もし他の指定方法がありましたら
ご伝授ください。
お助けいただき、ありがとうございます。
みなさまのおかげで無事解決しました。
また分からないことが発生しましたら質問させていただきます!
No.2
- 回答日時:
「新しいブックをアクティブにする記述がわからず、」
解答=>
Set mb = Workbooks.Addとしているからmbが新しいワークブックオブジェクトです。これをアクティブにするなら、
mb.Activate
とします。mbに"hoge.xls"の名前をつけて保存するには、
mb.SaveAs("hoge.xls")
とできます。
この回答への補足
さっそくのご解答ありがとうございます。
上記の構文に書き足してみましたが、
なぜだか止まってしまうのです。。
新しいブックにいくことが出来ません。
何か書き方が悪いのでしょうか・・
mb.Activate
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Sheets("Sheet3").Activate
ActiveWindow.SelectedSheets.Delete
お助けいただき、ありがとうございます。
みなさまのおかげで無事解決しました。
また分からないことが発生しましたら質問させていただきます!
No.1
- 回答日時:
新しく開いたBookって
>Set mb = Workbooks.Add '新しいコピー先ブックをmbとする。
これの事?
そうであれば
md.Activate
でアクティブになるかと。
この回答への補足
さっそくのご解答ありがとうございます。
上記の構文に書き足してみましたが、
なぜだか止まってしまうのです。。
新しいブックにいくことが出来ません。
何か書き方が悪いのでしょうか・・
mb.Activate
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Sheets("Sheet3").Activate
ActiveWindow.SelectedSheets.Delete
お助けいただき、ありがとうございます。
みなさまのおかげで無事解決しました。
また分からないことが発生しましたら質問させていただきます!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/05/24 08:33
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) 特定の文字を含むシートだけマクロ処理をしたい 1 2023/05/22 01:43
- Visual Basic(VBA) シートをコピーする下記記述でダイアログを用いた記述がわかりません?( A = Dir(ThisWor 4 2022/08/22 12:26
- PowerPoint(パワーポイント) エクセルのマクロについて教えてください。 1 2022/03/25 17:03
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Excel(エクセル) 複数のブックをひとつのブック(複数のシートにまとめる)場合にシートとの順番について 5 2022/12/28 20:47
- Visual Basic(VBA) VBA This Workbookモジュールを別ファイルにコピーする方法 1 2022/09/14 01:51
- Excel(エクセル) フォルダ内の全ブックのシート名を変更したい 7 2022/09/22 21:34
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
EXCELマクロで、開いてはいるがアクティブでないファイルをアクティブにする方法?
Excel(エクセル)
-
Excel VBAで同じフォルダ内のファイルを開くには?
Excel(エクセル)
-
ExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。
Visual Basic(VBA)
-
-
4
EXCEL VBAで全選択範囲の解除
Excel(エクセル)
-
5
名前の変わるブックをアクティブにしたい。
Excel(エクセル)
-
6
メッセージボックスに表示する文字を大きくしたい
Excel(エクセル)
-
7
別ブックをダイアログボックスで指定してそこにあるシートをコピーしたい
Excel(エクセル)
-
8
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
VBA 複数のエクセルから一つの...
-
別ブックをダイアログボックス...
-
ワイルドカード「*」を使うとう...
-
vbaでvbaProjectのパスワード解...
-
(マクロ)データをAブックからB...
-
VBAで別のブックにシートをコピ...
-
VBA 別ブックからコピペしたい...
-
フォルダ内の全てのファイルに...
-
VBAで複数のブックを開かずに処...
-
VBA シート名が一致した場合の...
-
VBS Bookを閉じるコード
-
VBAで別ブックのシートを指定し...
-
複数のエクセルブックをひとつ...
-
【VBA】全シートの計算式を全て...
-
【ExcelVBA】zip圧縮されたCSV...
-
エクセルマクロで、他ブックか...
-
2つ目のコンボボックスが動作...
-
VBA 実行時エラー 2147024893
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
別ブックをダイアログボックス...
-
ワイルドカード「*」を使うとう...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
VBS Bookを閉じるコード
-
【ExcelVBA】インデックスが有...
-
VBA コードを実行すると画面が...
-
【ExcelVBA】zip圧縮されたCSV...
-
vbaでvbaProjectのパスワード解...
-
VBAで別ブックのシートを指定し...
-
ExcelのVBAです。フォルダ内の...
-
vbaで他のブックに転記したい。...
-
フォルダ内の全てのファイルに...
-
VBAで複数のブックを開かずに処...
-
VBSでExcelのオープン確認
-
VBA 実行時エラー 2147024893
-
【Excel VBA】書き込み先ブック...
-
VBA シート名が一致した場合の...
おすすめ情報