集めたシートのシート名を変更したい。 下記のコードでサブフォルダにあるファイルのSheet3を集めて

集めたシートのシート名を変更したい。
下記のコードでサブフォルダにあるファイルのSheet3を集めています。しかし集めたシート名を元ファイル名の左から6文字にしたのですが解りません？
「Worksheets(Worksheets.Count).Name = Left(.Name, 6)」を何処に置いたら良いか教えてください。よろしくお願いいたします。
・・・・・・・・・・・・・・・・・・・・・・・・・・・
Sub シートコピー()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FolderName As String '文字列を入れる変数として「FolderName」を使う
Dim index As Integer '数字を入れる変数として「index」を使う
Dim FileName As String '文字列を入れる変数として「FileName」を使う
FolderName = Application.GetOpenFilename 'ダイアログを用いて選択したファイルのパスをFolderNameとする?@
If FolderName = "False" Then 'FolderNameが選択されていなければ作業を終了する
Exit Sub
End If
'今のフォルダ名には選択したファイル名含まれているので、ファイル名の部分を切り取る作業。
index = InStrRev(FolderName, "\") 'フォルダ名部分の文字数をカウントする
FolderName = Left(FolderName, index) ' カウントした文字数までの部分を切り取ってフォルダ名とする
FileName = Dir(FolderName & "*xls*") ' フォルダの中に含まれるファイルを取り出す
Do While FileName <> "" ' ファイルがなくなるまで繰り返す
Workbooks.Open FolderName & FileName 'ファイルを開く
Worksheets(3).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'シートをコピーして取得
Workbooks(Workbooks.Count).Save
Workbooks(Workbooks.Count).Close
FileName = Dir() '
Loop
End Sub

質問者からの補足コメント

• 重複シートのチェック確かに必要です。
  またフォルダを指定するApplication.FileDialog(msoFileDialogFolderPicker)
  どうやって使ったら良いかわかりません？
  ご指摘どおり、.nameでは参照が正しく無いとエラーになります。withを付けて見ましたが別のエラーとなりました？ご教授頂けるとありがたいです。よろしくお願いします。

    補足日時：2022/08/23 13:24

No.5 ベストアンサー 回答者： Qchan1962 回答日時： 2022/08/23 16:21

こんにちは

Application.FileDialog(msoFileDialogFolderPicker)どうやって使ったら良いかわかりません？

ご質問のコードの場合、この様な感じ
Dim FolderName As String '文字列を入れる変数として「FolderName」を使う
Dim FileName As String '文字列を入れる変数として「FileName」を使う
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
FolderName = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With

この後の　index =などのコードは不要
*注
Workbooks.Open FolderName & FileName　なので
.SelectedItems(1) & "\"　としています


＞Worksheets(3).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)　で自動的に付く名前の挙動と似せたリネーム

サブで書くと
Sub sheetReName(sht As Worksheet, FileName As String)
Dim n As Integer
On Error GoTo reNameErr:
sht.Name = Left(FileName, 6)
reNameErr:
If Err.Number <> 0 Then
Err.Number = 0
n = n + 1
On Error GoTo reName:
sht.Name = Left(FileName, 6) & "(" & n & ")"
End If
End Sub

サブを呼ぶ場所と引き数　ご質問コードの場合

Do While FileName <> "" ' ファイルがなくなるまで繰り返す
Workbooks.Open FolderName & FileName 'ファイルを開く
Worksheets(3).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'シートをコピーして取得
Call sheetReName(ActiveSheet, FileName)　'ここで呼ぶ
Workbooks(Workbooks.Count).Close SaveChanges:=False
FileName = Dir()
Loop

細切れ回答にしましたので、ご自身でデバッグしながら組んでみてください

この回答へのお礼

Subを差し込む　拙い私の思考で理解できました。
ありがとうございます。

お礼日時：2022/08/23 18:39

No.6 回答者： fujillin 回答日時： 2022/08/23 16:53

No1です。

＞重複シートのチェック確かに必要です。
チェック方法はいろいろ考えられます。
以下に、よくある方法を列挙。
　1）事前にブック内のシート名のリスト（＝配列やDictionary）を作成して
　　おいてテストする名前が存在するかチェックする
　2）現状のシートをループして、テストする名前が存在するかチェックする
　3）テストしたいシートを取得して、エラーが発生すれば存在しないと判断
などでしょうか。（　1）、2）は同じようなものですが・・）
例えば、3）の場合で、変数 testname にシート名があるとして
On Error Resume Next
Set sh = ThisWorkbook.Worksheets(testname)
If Err.Number = 9 Then MsgBox testname & "は存在しません"
On Error GoTo 0

で、既存シートの有無をチェックできるでしょう。
（エラーが発生しなければ、既に存在するということになります）


＞フォルダを指定するApplication.FileDialog(msoFileDialogFolderPicker)
＞どうやって使ったら良いかわかりません？
検索しさえすれば、使用方法は見つかるはずと思いますが・・
With Application.FileDialog(msoFileDialogFolderPicker)
　If .Show Then folderpath = .SelectedItems(1)
End With
MsgBox "[" & folderpath & "]"

のような要領で。
キャンセルや「×」でクローズした場合には、 folderpath は初期値のままとなります。
（元に何も入ってなければ、空　白文字列が返ります）


＞.nameでは参照が正しく無いとエラーになります。
＞withを付けて見ましたが別のエラーとなりました？
どのようなシート名を使用したいのかによりますが、WIthを正しく設定すればエラーにはならないはずと思います。

例えば、元のシート名が「hoge」の場合で、コピー先に既に「hoge」シートが存在すると、コピーしたシート名は「hoge(2)」としてコピーされると思います。
この時に、左6文字という意味が、
　・元のシート名の左6文字 = hoge
　・コピーされたシートの左6文字 = hoge(2
のどちらかによるという意味です。

ありそうなのは、前者でしょうから、それなら
　Workbooks(FileName).Worksheets(3).Name
を利用すれば良いのではないでしょうか？
（処理の途中で、WorkbookやWorksheetなどを変数に代入しておけば、指定は簡単になります）

これから6文字を切り取って、上記の存在チェックを行えばよいことになるのではないでしょうか？
同名シートが存在した場合にどうするのかの記載がないので、その場合の処理に関しては、こちらではわかりかねます。

この回答へのお礼

ありがとうございます。勉強させていただきます。

お礼日時：2022/08/23 19:14

No.4 回答者： めぐみん_ 回答日時： 2022/08/23 16:10

No.3です。

＞しかし集めたシート名を元ファイル名の左から6文字にしたのですが解りません？

集めたってのは

＞ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

ここにあるシートじゃないの？
それとも開いた別Ｂｏｏｋのシート名を変えたいの？
ActiveSheet？
worksheets(3)？

No.3 回答者： めぐみん_ 回答日時： 2022/08/23 15:26

重複シートのチェックとしては、別Ｂｏｏｋにも同じシート名があると言う訳ではない（一纏めにした時同じシート名が二つ以上存在しない）のである事が最初の絶対的条件であると仮定する。

まずは纏めるＢｏｏｋのシート名を集めて記録し（Dictionaryオブジェクトとか）、次にフォルダから開いたＢｏｏｋのWorksheets(3).NameがDictionaryオブジェクトに存在するか否かを調べて存在しないならコピペはしない。

または同じ名前があった際にも何らかの行動をしたいのであれば、その辺を明確に提示する。
⇒スマホの変換候補で英字が半角・全角になってしまい読みにくく申し訳ないです。

No.2 回答者： t_fumiaki 回答日時： 2022/08/23 11:30

シートをコピーすると、新しくコピーされたシートがアクティブになるので、それを使うのが早いのでは？

ActiveSheet.Name= Left(.Name, 6)をコピー文のすぐ下に入れる。

No.1 回答者： fujillin 回答日時： 2022/08/23 11:16

こんにちは

＞何処に置いたら良いか教えてください。
シートをコピーした後でリネームすれば良いでしょう。

＞Worksheets(Worksheets.Count).Name = Left(.Name, 6)
.Name と省略形にしているけれど、そのままでは上手くいかないのでは？
それに、同じ名前が既に存在しているかどうかのチェックは不要なのでしょうか？

なお、ご質問には関係ありませんけれど・・
フォルダーを取得したいのにファイル選択ダイアログを表示するのって（最近どこかでも見かけたけれど）、ユーザーにとっては不可解な動作になりませんか？
フォルダを取得したいのなら、素直に、Application.FileDialog(msoFileDialogFolderPicker) などを用いる方が、わかりやすいと思うのは私だけなのかなぁ？

この回答へのお礼

ありがとうございます。

お礼日時：2022/08/23 13:14