行選択した文書のみダウンロード_チェックボックス

質問

いつも大変お世話になっております。
以前http://okwave.jp/qa/q6003799.html、こちらでお世話になり、m(_ _)m
当時完成させたものに対して「いくつかの」仕様変更を求められました。
ここ数カ月程、ずっと挑戦しては悩んでおります。
期限が迫ってきましたので今回投稿しました。
「過去に何かを作成したことはなく、現在のものをいきなり実践で作成という経緯」なので、
一からcodeを入力する技量は全くありません。
以前ご回答いただいたものを「いじり」ながら変更を行っています。
Windows7　Excel2010になります。
別カテゴリで2週間以上回答がつきませんでした。再投稿になります。
どうぞ宜しくお願い致します。

<以前は＞
一括文書のダウンロード
(1)B列に「レ」を入力
(2)オートフィルタを実施
(3)(1)、(2)で選んだ行のＣ、Ｄ列のリンク文書のみ指定場所に一括ダウンロード
(4)その際に複数フォルダ作成を行い、その中へダウンロードする各ファイルを指定したファイル名へ変更してから保存
(5)ダウンロードした場所のリンク先にC、D列のハイパーリンク先を変更
<今回は>
グループごとに文書 ダウンロード
　　例）第一グループにある資料＝「ファイルの保存1」ボタンを実行
(1)B列にチェックボックスを作成
(2)(1)でチェックボックスがONとなっているＣ、Ｄ列のリンク文書のみ指定場所にダウンロード
(3)指定したフォルダ名でフォルダを作成し、その中へ(2)を指定したファイル名へ変更し保存
(4)ダウンロードした場所のリンク先にC、D列のハイパーリンク先を変更
(5)第二グループからはAB列とAC列の数字を比較して、違う場合はAC列の数字のフォルダ（グループ）内へ戻り検索、該当文書のショートカットキ－を作成してAB列の数字のフォルダ（グループ）の中へ保存

<現在の状態>
<今回は>の(1)(3)(4)ができていて，(2)ができていません。（指定フォルダ名の作成はできていていますが，指定した範囲の全ての文書が保存されてしまいます。）チェックボックスがONとなっている行のＣ，Ｄ列のリンク文書のみ指定場所にダウンロードを行いたいのです。(5)の動作についてもかなり苦戦しているため切羽詰っている状態です。アドバイスいただけると大変助かります。
※チェックボックスはフォームコントロールで作成したチェックボックスです。
　フォーム上には作成しておらずシート上に作成しています。
　コントロールの書式設定にリンクするセルにはチェックボックスのすぐ下のセル「例）$34$」などとして，TRUE/FALSEを表示させています。
　このTRUEの数を拾えるところまではできましたが，下記「ku」で拾えたTEUEの数をどう生かせばいいのかわかりません。

Sub try2()
CreateObject("WScript.Shell").CurrentDirectory = ThisWorkbook.Path
Dim BookName, BookName2, n, f, hLink, xName, xName2,NNN, Holdir, X, chk, returnValue As String
Dim Rng As Range
Dim H As Hyperlink
Dim hd1 As String
Dim FSO As Object
Dim ku As Long
ActiveSheet.Unprotect
With ThisWorkbook.Sheets("参考資料")
ActiveSheet.Shapes("Button5").Select
ActiveSheet.Range("$B$34:$B$40").AutoFilter Field:=1
Set Rng = Intersect(.AutoFilter.Range.EntireRow, .Range("B34").CurrentRegion)
n = "_" & .Range("C3").Value
f = .Range("C5").Value
'ChDrive ThisWorkbook.Path 'ドライブ移動
ChDir ThisWorkbook.Path 'エクセルファイルのある場所に移動する
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(ThisWorkbook.Path & "\" & "1.第一") Then
MsgBox "既にご指定場所に，同名フォルダがあるようです。" & vbCrLf & "ご確認の上，再操作をして下さい。" & vbCrLf & "動作を抜けます。"
Exit Sub
Else
MkDir ThisWorkbook.Path & "\" & "1.第一"
End If
Set FSO = Nothing
End With
Set Rng = Intersect(Rng, Rng.Offset(1), Rng.SpecialCells(xlCellTypeVisible))
'抽出なければ抜ける
If Rng Is Nothing Then Exit Sub
'UserForm1.Repaint
'■※1）画面更新停止
Application.ScreenUpdating = False
hd1 = "1.第一"
With ThisWorkbook.Sheets("参考資料")
ActiveSheet.Range("$B$34:$B$40").AutoFilter Field:=1
Set Rng = Intersect(.AutoFilter.Range.EntireRow, .Range("B34").CurrentRegion)

ku = WorksheetFunction.CountIf(Range("B34:B40"), "TRUE")　←ここのkuの結果（チェックボックスの結果がTRUEだった行）のみ以下の動作（ファイルのダウンロード）を行いたい

'rng.HyperlinksをLoop
For Each H In Rng.Hyperlinks
hLink = H.Address
chk = LCase(Mid$(hLink, InStrRev(hLink, ".")))
Select Case chk
Case ".xls", ".xlsx", ".doc", ".docx", ".pdf"
xName = Mid$(hLink, InStrRev(hLink, "/") + 1)
NNN = ThisWorkbook.Sheets("参考資料").Range("AA" & H.Range.Row).Value
X = ThisWorkbook.Sheets("参考資料").Range("AB" & H.Range.Row).Value
xName2 = NNN & chk
Holdir = "\" & hd1 & "\"
BookName = ThisWorkbook.Path & "\" & Holdir & Replace$( _
xName2, chk, n & "_" & f & chk, , , vbTextCompare)
BookName2 = hd1 & "\" & NNN & n & "_" & f & chk
'URLDownloadToFile API をコールする
returnValue = URLDownloadToFile(0, hLink, BookName, 0, 0)
H.Address = BookName2
ActiveSheet.Range("$B$34:$B$40").AutoFilter Field:=1
End Select
Next
End With
'Unload UserForm1
'■※1）画面更新再開
Application.ScreenUpdating = True
End Sub

かなりの説明下手ですので画像をご覧いただけたら・・・と思います。

大変申し訳ありませんが、
皆様、どうぞ宜しくお願い致します。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.1

n-jun

ku = WorksheetFunction.CountIf(Range("B34:B40"), "TRUE")

これだと”ＴＲＵＥ”と言う文字列をカウントしてますよね？
本来はBoolean型だから

ku = WorksheetFunction.CountIf(Range("B34:B40"),True)

なのでは？

お礼

こんにちは。
ご指摘，ありがとうございました。
（修正しました。助かりました。）

Kuでは数を拾えていますが
全文書をダウンロードしてしまうところがわからなくての投稿でしたのでとりあえずお礼だけとなってしまって申し訳ありません。
本当にありがとうございました。