VBA 複数のブックから複数のシートをまとめたい

Question

前提・実現したいこと

VBAで複数のブックから複数のシートを一つのブックにまとめたい。

発生している問題・エラーメッセージ

ブックによってとりだしたいシートが1つの時と2つの時があるのですが2つめがあった場合は2つめもまとめてなかった場合はスルーしたいのですがスルーができません。
また、シート名をブック名にしたいのですが2つめがあった場合は[ブック名.2]としたいのですがその指定もできません。
エラーメッセージ

該当のソースコード

VBA
ソースコード
Sub Sample()
   Dim sFile As String
   Dim sWB As Workbook, dWB As Workbook
   Dim dSheetCount As Long
   Dim i As Long
   Const SOURCE_DIR As String = "フォルダ"
   Const DEST_FILE As String = "ブック"
   
   Application.ScreenUpdating = False
   
   '指定したフォルダ内にあるブックのファイル名を取得
   sFile = Dir(SOURCE_DIR & "*.xls")
   
   'フォルダ内にブックがなければ終了
   If sFile = "" Then Exit Sub
   
   '集約用ブックを作成
   Set dWB = Workbooks.Add
   
   '集約用ブック作成時のシート数を
   dSheetCount = dWB.Worksheets.Count
   
   Do
       'コピー元のブックを開く
       Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)
 
       
       
       'コピー元の「a,a(2)←あれば」シートを集約用ブックにコピー
       sWB.Worksheets(Array("a", "a(2)")).Copy After:=dWB.Worksheets(dSheetCount)
       
       
       
       'シート名をフォルダ名、a(2)がある場合はフォルダ名.2
       ActiveSheet.Name = sFile
       'コピー元ファイルを閉じる
       sWB.Close
       
       '次のブックのファイル名を取得
       sFile = Dir()
   Loop While sFile <> ""
       
   '集約用ブック作成時にあったシートを削除
   Application.DisplayAlerts = False
   For i = dSheetCount To 1 Step -1
       dWB.Worksheets(i).Delete
   Next i
   Application.DisplayAlerts = True
     
   '集約用ブックを保存して閉じる
   dWB.SaveAs Filename:=DEST_FILE
   dWB.Close
   
   Application.ScreenUpdating = False
End Sub
### 試したこと
ここに問題に対して試したことを記載してください。
ふくすう
### 補足情報（FW/ツールのバージョンなど）
ここにより詳細な情報を記載してください。

Comments

[sazi]

要件は前質問の方が良くまとまっていましたよ。

Answer 1

Dim ws As Worksheet
For Each ws In sWB.Worksheets
    If ws.Name = "a" Then
        ws.Copy After:=dWB.Worksheets(dWB.Worksheets.Count)
        ActiveSheet.Name = sFile
    ElseIf ws.Name = "a(2)" Then
        ws.Copy After:=dWB.Worksheets(dWB.Worksheets.Count)
        ActiveSheet.Name = sFile & ".2"
    End If
Next

Comments

[退会済みユーザー]

jinoji様
回答ありがとうごうございます。
無事動きました、できれば拡張子を消したく
試行錯誤していましたがうまくいきませんのでもしよろしければ教えてください。

[jinoji]

たとえば
Left(sFile, InStrRev(sFile, ".") - 1)
とかでできると思います。

[退会済みユーザー]

構文エラーがでてしまします。
こちらだとa.2の場合に.2も消えてしましませんか？

[jinoji]

.2をつける前の sFile の部分を、上記の記述に差し替えるという意味で書きました。
あるいは、以下のようにしたらわかりやすいですか。

Dim sFileBaseName
sFileBaseName = Left(sFile, InStrRev(sFile, ".") - 1)

Dim ws As Worksheet
For Each ws In sWB.Worksheets
If ws.Name = "a" Then
ws.Copy After:=dWB.Worksheets(dWB.Worksheets.Count)
ActiveSheet.Name = sFileBaseName
ElseIf ws.Name = "a(2)" Then
ws.Copy After:=dWB.Worksheets(dWB.Worksheets.Count)
ActiveSheet.Name = sFileBaseName & ".2"
End If
Next

[退会済みユーザー]

お手数お掛けしますが
sFileBaseName = Left(sFile, InStrRev(sFile, ".") - 1)
この文でコンパイルエラーがでてしまいます。

[退会済みユーザー]

無事動きました、ありがとうございました。