こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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セルから指定できるようにしたいです。
宜しくお願いします。

投稿日時 - 2020-03-17 09:27:15

QNo.9724370

困ってます

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

(1)
Dim w As Worksheet
Set w = Worksheets("部署")
(2)
myPath = ActiveWorkbook.Path & "\" & Worksheets("Sheet1").Range("B2")

投稿日時 - 2020-03-17 10:03:16

補足

ありがとうございます。
Set w = Worksheets("部署")を追加し、Set w = ActiveSheetを削除することで出来ました。

myPath = ActiveWorkbook.Path & "\" & Worksheets("Sheet1").Range("B2")
の方はtestファイルの中に保存してなく、同じ場所に2〇〇.xlsxとなってしまいます。

投稿日時 - 2020-03-17 10:53:24

お礼

myPath = ActiveWorkbook.Path & "\" & Worksheets("Sheet1").Range("B2") & "\"
に変更することでできました。
ありがとうございました。

投稿日時 - 2020-03-17 10:57:04

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問