新しく開いたブックをアクティブにするマクロ
マクロ 新しく作ったブックをアクティブにする
マクロ初心者です。
マクロを使って同階層にあるファイルのアクティブのシートを
ひとつのブックにコピーして保存するマクロを作りたいと思ってます。
他の質問を参照して下記のコードを途中まで作成しました。
参照した質問では、
マクロの入っているブックにシートをコピーするようでしたが、
そうすると保存した時にマクロも保存されてしまうので
私なりに調べて、新しいブックにシートコピーするようにしましたが、
この記述の後、新しいブックをアクティブにする記述がわからず、
保存できなくなってしまいました。
ここまで終わるとマクロの入っているブックがアクティブになって終わります。
このあと新しく開いたブックをアクティブにして、
ブックの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 '繰り返す
・
・
・
・
![その他([技術者向] コンピューター) イメージ](https://gazo.okwave.jp/okwave/spn/images/related_qa/c205_1_thumbnail_img_sm.png)
お礼
回答を有難うございます。 やはりWindows updateの不具合は、皆さんの話題になっているのですね。 今回は、アンインストールで解決をしました。有難うございました。