マクロ初心者です、エクセルでファイルの読込フォルダを固定から選択式に変更したいです。

マクロ超初心者です　ファイルの読込フォルダを固定から選択式に変更したいです。
下記のC:\test\フォルダの指定をコメントバック部分に入れ替えただけでは
「実行時エラー'13' 型が一致しません。」となってしまいます。
何か定義の型とか色々と修正しないと駄目かと思いますが、超初心者が切り貼りで
作っている状態でぜんぜんわかりません。
どなたか教えてください、よろしくお願いします。

Private Const MESSAGE_START = "ファイルの読み込みを開始します" & vbCrLf & "フォルダを選択してください。"
Private Const MESSAGE_FINISH = "ファイルの読み込みが完了しました"
Sub ExcelbookCombine()
'-------------------------------------------------------------------------------------------------------
'処理開始
'-------------------------------------------------------------------------------------------------------
MsgBox MESSAGE_START
Range("A2:Z10000").Select
Selection.ClearContents
Range("A2:Z10000").ClearFormats
'With Application.FileDialog(msoFileDialogFolderPicker)
' If .Show = 0 Then Exit Sub
' FolderPath = .SelectedItems(1)
'End With
Const Fol As String = "C:\test\"
Dim Fn
Dim NewFile As Workbook
Dim Wb As Workbook
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim R As Range
Dim SrcRng As Range
Dim Rng As Range
Set SrcRng = ActiveSheet.Range("A2")
Set Ws1 = Worksheets(1)
Set R = Ws1.Range("A2")
Fn = Dir(Fol, vbNormal)
Do Until Fn = ""
Set Wb = Workbooks.Open(Fol & Fn)
'ワークシート1をコピーする場合は Wb.Worksheets(1)
'ワークシート2をコピーする場合は Wb.Worksheets(2)
Set Ws2 = Wb.Worksheets(1)
'Aの2行目から8列目までをコピーして結合する
'Ws2.Range("A2", Ws2.Cells(Rows.Count, 1).End(xlUp)).Resize(, 17).Copy R
' Set R = R.End(xlDown).Offset(1)
'Ws2.Range("A2", Ws2.Cells(Rows.Count, 1).End(xlUp)).Resize(, 17).Copy R
'Ws2.Range("A2:P" & Ws2.Range("A65536").End(xlUp).Row).Copy R.Range("a" & Ws1.Range("a65536").End(xlUp).Row).EntireRow.PasteSpecial(xlPasteValues)
'Ws2.Range("A2:P" & Ws2.Range("A65536").End(xlUp).Row).Copy Ws1.Range("a" & Ws1.Range("a65536").End(xlUp).Row + 1).PasteSpecial(xlPasteValues)
' Set R = R.End(xlDown).Offset(1)
' データの行数 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row
' Ws1.Range("A2:P" & データの行数).Value = Ws2.Range("A2:P" & データの行数).Value
With Wb.Worksheets(1)
Set Rng = Ws2.Range("A2", Ws2.Cells(Rows.Count, 1).End(xlUp)).Resize(, 16)
SrcRng.Offset(i).Resize(Rng.Rows.Count, 16).Value = Rng.Value
i = i + Rng.Rows.Count '一行開ける
End With
Wb.Close
'Debug.Print Fn
Fn = Dir
Loop
MsgBox MESSAGE_FINISH
Set R = Nothing
Set Ws1 = Nothing: Set Ws2 = Nothing
Set Wb = Nothing: Set NewFile = Nothing
End Sub

No.1 回答者： siffon9 回答日時： 2016/04/17 10:08

変数名が違うだけではないでしょうか？

> FolderPath = .SelectedItems(1)
> Const Fol As String = "C:\test\"


FolderPath = .SelectedItems(1)
↓
Fol = .SelectedItems(1)

この回答へのお礼

ありがとうございます
上記のように修正して
実行してフォルダ指定したのですが
エラーにならずに処理が始まらないまま
エンドのメッセージが出ました。

ファイルみつけられなかったのでしょうか
もっと詳しく見てみます

お礼日時：2016/04/17 10:25

No.2 回答者： hallo-2007 回答日時： 2016/04/17 11:06

'With Application.FileDialog(msoFileDialogFolderPicker)

' If .Show = 0 Then Exit Sub
' FolderPath = .SelectedItems(1)
'End With
Const Fol As String = "C:\test\"
の部分活用していますか

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = 0 Then Exit Sub
Fol = .SelectedItems(1)
End With
もちろん、フォルダを選択しなければ
Exit Sub　ですが。
一度
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = 0 Then Exit Sub
Fol = .SelectedItems(1)
End With
MsgBox Fol
とかとMsgboxで確認してみてください。

この回答へのお礼

ありがとうございます
msgboxで確認しましたが
ちゃんと指定したフォルダパスが表示されていました。

folの中に指定したフォルダへのパスが入っているのに
処理がされないっていうのはどういうことでしょうか？

お礼日時：2016/04/17 11:27

No.3 回答者： hallo-2007 回答日時： 2016/04/17 11:56

こちらも試してみてください。

Set Wb = Workbooks.Open(Fol & Fn)
を
Set Wb = Workbooks.Open(Fol & & "\" & Fn)

他のサイトのコードをコピーされていると思いますが
かなりごちゃごちゃになっていませんか？
今一度、ご自身の仕事と比較されては如何でしょうか？
例えば
Range("A2:Z10000").Select
Selection.ClearContents
Range("A2:Z10000").ClearFormats
ですが
Range("A2:Z10000").Clear
ですが、せっかくコピーしたデータをクリアするのでしょうか。
例えば
　A列に、取込日時　とか列を追加しておいて
ひたすらデータが下方向へ追加されるようにします。
http://www.moug.net/tech/exvba/0060003.html
のサイトにも同じようなコードがありますが
取込後に、誤って2重に操作することの防止のために
取込後は、データを削除しておきます。
こうすることで、取込のデータが複数のフォルダーに分散して
残っていくことがなくなるのではないでしょうか。

この回答へのお礼

色々とお気遣いありがとうございます
クリア部分は跡で自分で足したので業務的には大丈夫です。
各店が日ごとにつけている入金データファイル（日ごとの入金額が
１か月分の表になっている）を月ごとにフォルダ管理して月ごとに
集計しようと考えています。
この取り込みデータを基に残高一覧を作成するのですが
各店によって確実に更新できてない場合もあり
一度取り込み状況をみて、取り込めていない店舗があったら
指示を出し。更新後に再取り込みするのでクリア仕様にしています。

下記コードは同じ症状で貼付けせずに終わってしまいました。
（＆はひとつ多いですよね？削除しています）
Set Wb = Workbooks.Open(Fol & "\" & Fn)

お礼日時：2016/04/17 12:20

No.4 回答者： hallo-2007 回答日時： 2016/04/17 13:07

Fn = Dir(Fol, vbNormal)

を
Fn = Dir(Fol & "\*.xls*")
とXlsファイルに限定してみませんか？
Fn = Dir(Fol & "\*.xls*")
msgbox Fn
Do Until Fn = ""
で確認してみます。
ついでに
＞各店が日ごとにつけている入金データファイル（日ごとの入金額が
１か月分の表になっている）
なので、行数は　Maxでも３１行（2行目からデータなので2行目から32行目）
' データの行数 = Ws2.Cells(Rows.Count, 1).End(xlUp).Row
' Ws1.Range("A2:P" & データの行数).Value = Ws2.Range("A2:P" & データの行数).Value
を
Gyou = Ws1.Cells(Rows.Count, 1).End(xlUp).Row+1
'Ws1.Range("A" & Gyou & ":P" & Gyou+31).Value = Ws2.Range("A2:P32" ).Value
で試しでも大丈夫では。

この回答へのお礼

ありがとうございます！
とりあえずエクセルファイル指定したら出来ました！

Gyouのほうはコピペだとうまくいきませんでしたが
お察しのとおり、３１日の次に合計行が貼り付けられて
困っているところですｗ
これも検討している状態なんです、Gyouをよく見てみます。
ありがとうございます！

お礼日時：2016/04/17 13:28

No.5 回答者： hallo-2007 回答日時： 2016/04/17 13:54

＞お察しのとおり、３１日の次に合計行が貼り付けられて

困っているところですｗ
合計が何列目にあるかですね。
Ws1.Cells(Rows.Count, 1).End(xlUp).Row+1
Ws1のA列の最終行を見に行っていますので
A列の最終行に合計とか文字などがなければ大丈夫ではないでしょうか。
全てのファイルのデータ取り込み後の最終行に　合計が出てしまうケースも
あるかと思いますが。
配布されるデータですが、合計を表示するセルは　上の方が使いやすくないでしょうかね
例
１　今月の合計
２　=sum(??)
３　日付
４　１
５　２
・・・
として、表示で枠を固定して合計が常に見える様にしておきます。
合計の関数のセルを移動することもないでの使いやすく見やすくなります。

この回答へのお礼

ありがとうございます。
するどいですね！合計行を上にして。それで逃げようとしていましたｗ
それで逃げようと考えつつ後学のために範囲指定の値コピペを
探している状態です、お見通しですねｗ

ちなみにデータの行数の部分は、まだ動いた実績が
ないのでいじっても動きませんでした。。。

お礼日時：2016/04/17 14:18

No.6 ベストアンサー 回答者： hallo-2007 回答日時： 2016/04/17 14:30

お付き合いついでと云う事で

次ステップですが
毎月のデータがフィルダーごとに残るデータ保存の方法を考えましょう。
永遠にファイルとフォルダーが増えて、過去の検索も大変になるでしょう。
毎月のデータを保存するフォルダーを一つ
データを取込後に、年と月の情報を入れる列を作る。
常に一枚のシートでデータを管理する。
こうすることで、一年の入金金額なども簡単に集計できますよね。
月ごとのグラフも作成できるでしょう。
頑張ってみてください。

この回答へのお礼

ありがとうございます！

お礼日時：2016/04/17 15:00