マクロのワイルドカードの使い方&ループ記述について

質問

マクロ初心者です！
下記の動作を実現したいのですが、
「（下記★の）フォルダが見つかりません。移動や削除が行われた可能性があります。」とエラーが出ます。

初心者のためエラーの理由がわからず、そもそも記述が間違っているのかも不明な状況です。
知識をお持ちの方がいらっしゃれば、下記動きを実現するために、どこを修正する必要があるのか、
ご教示いただけますと幸いです。。。

実現したい動きとしては以下です。

・・・・・・・・・・・・・・・・・・・・・・・・・・・
ファイル名に「あいう」を含むファイルを開く
→F25:F42の値をコピー …(1)

ファイル名に「えお」を含むファイルを開く
→F25:F42の値をコピー …(2)

(1)と(2)を加算して、貼り付け先ファイルのF25:F42に貼り付け

→以上の動きをF列～AC列まで1列おきに行う。
※以上のすべてのファイルは同じフォルダ内に格納されています。
・・・・・・・・・・・・・・・・・・・・・・・・・・・

そして、書いてみたマクロは以下です。

Sub マクロ()

Dim i As Integer
For i = 5 To 28 Step 2

Dim xAdr As Range
Set xAdr = Range(Cells(25, i), Cells(42, i))

Dim ex As New Excel.Application
Dim wb As Workbook
Dim wbA As Workbook

Dim sPath
Dim sPathA

Dim r As Range
Dim sht As Worksheet

With Workbooks("貼り付け先ファイル.xlsm").Worksheets("指定sheet")

sPath = "C:\Users\指定フォルダ\*あいう*.xlsm" ★
Set wb = ex.Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)

wb.Worksheets("指定シート").Range(xAdr).Copy
.Range(xAdr).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd

Call wb.Close

sPathA = "C:\Users\指定フォルダ\*えお*.xlsm"
Set wbA = ex.Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)

wbA.Worksheets("指定シート").Range(xAdr).Copy
.Range(xAdr).PasteSpecial Paste:=xlPasteValues

Call wbA.Close

End With
End Sub

どうぞよろしくお願いいたします。。

回答No.2

kkkkkm · ベストアンサー

以下のサイトを参考にしてください。
Dir
指定したファイルまたはフォルダの名前を返します。
引数pathnameにはワイルドカードを使用できます。
http://officetanaka.net/excel/vba/function/Dir.htm
サンプルの
cnt = cnt + 1
の部分にファイルを開いて作業をして閉じるまでを記載してください。
また
tmp
にフルパスが入っているかどうかも確認してあとのコードを作成してください。

回答No.1

WDY

「（下記★の）フォルダが見つかりません。移動や削除が行われた可能性があります。」
という事はファイルが無いんじゃないですか？

それと取得したファイル名が複数になる事があるので
取ってきたファイル名のどれを開くか指定しないとエラーになると思います。

そもそもなぜ開いているのでしょうか？
中身を参照すれば良いのでは？
http://officetanaka.net/excel/vba/tips/tips28.htm