| |
▼もも さん：書込み有難うございます。
ユーザー毎の集計処理を実施したく、
シートの中の以下部分のように直接指定すれば動くのですが
【Sheets(1).Move After:=Workbooks("プログラム調査.xls").Sheets】
保存先のシートがユーザー毎に違うので間接指定し、ダイアログで選択するようにしたのですが、ファイル名が特定出来ないなかで、どいった指定をしたらよいのかが解りません。
作成したシートは以下です。
Sub 処理ALL()
'*******************ファイル３.xlsを選択し開く******************
Dim myCurDir As String
Dim myFile As String
Dim myTitle As String
myTitle = "ファイルの選択" '実行前のカレントフォルダ記憶
myCurDir = CurDir 'カレントフォルダ変更
'*********************フォルダを指定して「ファイルを開く」ダイアログを呼び出す
CreateObject("WScript.Shell").CurrentDirectory = "D:\新しいフォルダ\"
myFile = Application.GetOpenFilename("Excelファイル,*.xls", , myTitle) 'カレントフォルダを元に戻す
If myFile = "False" Then
MsgBox "処理を中止します", vbOKOnly + vbExclamation, "処理中止"
End If
Workbooks.Open (myFile)
CreateObject("WScript.Shell").CurrentDirectory = myCurDir
If myFile = "False" Then
MsgBox "キャンセルされました。"
End If
'*******************ファイルＢ.csvを開く******************
Workbooks.Open "C:\ABC\ファイルＢ.csv"
'*************シート名を日付にして新規作成する************
Dim MySh As Object, ws As Object
Dim NewShName As String
Dim i As Integer
Const MyDateRn As String = "M1" '←月日の入力セル
Set MySh = Worksheets("test") '取り込むファイル名
Set ws = Sheets.Add(Before:=Worksheets(1))
MySh.Cells.Copy Destination:=ActiveSheet.Range("A1")
NewShName = Format(Date, "YYYY年MM月DD日")
On Error GoTo ErrTrap
ws.Name = NewShName 'シート名の設定
On Error GoTo 0
Range(MyDateRn).Value = Date
Sheets(1).Select
Sheets(1).Move After:=Workbooks("プログラム調査.xls").Sheets(1) '書き込むファイル名
Sheets(2).Select
Application.DisplayAlerts = False
Windows("test.csv").Activate
ActiveWindow.Close
Application.DisplayAlerts = True
Exit Sub
'******************************************************
ErrTrap: i = i + 1
NewShName = Format(Date, "YYYY年MM月DD日")
NewShName = NewShName & "(" & i & ")" 'シート名に連番付与
Resume
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
