VBAで抽出とコピペのループがうまくいかない？

Excel2010のＶＢＡに詳しい方、至急です。
前回も同様の質問をして、回答していただいた方のアドバイスをもとに自分でも改善？してみたつもりなのですが無理だったので再度質問させていただきます。

ポケモン図鑑という表をタイプごとにリストを抽出して、
そのデータをA列に数値が入っている行から最後の行までをコピーして、
抽出した際の条件と同じ名前のシートに所定の場所に貼り付け、最後に貼り付け先のシートのとある箇所をコピーして、ポケモン図鑑というシートにデータをペーストするというマクロなんですが、実際に通しても数値が０となってしまいます。
メッセージボックスで入力した後、「終了しました」と出るのですが期待通りに抽出してコピー&ペーストができていないようで困っています。
だれかたすけていただけませんか。

※抽出する項目
lightening※1
fire※2
water
leaf
wind
dragon

※１抽出する際、テキストフィルターのユーザー設定で
「lightening」からはじまる「伝説・幻」を含まないという条件で抽出しなければならない。
※２抽出する際、テキストフィルターのユーザー設定で
「fire」からはじまる「伝説・幻」を含まないという条件で抽出しなければならない。

Sub Pokemon()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim hizuke As String, wnum As String
Dim rng As Range
Dim i As Long, imax As Long
Dim j As Variant, c As Long
Dim sname As String
Dim fsh As Variant
fsh = Array("lightening", "fire", "water", "leaf", "wind", "dragon")
hizuke = InputBox("ポケモンを捕まえた日付を入力して下さい")
If hizuke = "" Then Exit Sub
If IsDate(hizuke) = False Then
MsgBox "日付不正"
Exit Sub
End If
Set sh1 = Worksheets("ポケモン図鑑")
With sh1
Set rng = .Range(.Cells(4, 5), .Cells(4, .Cells(4, Columns.Count).End(xlToLeft).Column))
End With
j = Application.Match(CLng(CDate(hizuke)), rng, 0)
If IsError(j) Then
MsgBox "該当日付がありません"
Exit Sub
End If
wnum = InputBox("選択した日付が何週目になるかを入力して下さい")
If wnum = "" Then Exit Sub
If wnum < 1 Or wnum > 5 Then
MsgBox "週不正"
Exit Sub
End If
Application.ScreenUpdating = False
c = wnum * 2 + 3
For Each sh2 In Worksheets
For i = 0 To 5
If sh2.Name = fsh(i) Then
With sh2
If .Cells(5, c) <> "" Then
.Range(.Cells(5, c), .Cells(.Cells(Rows.Count, c).End(xlUp).Row, c)).ClearContents
End If
End With
Exit For
End If
Next i
Next sh2
With sh2
If .Cells(5, c) <> "" Then
.Range(.Cells(5, c), .Cells(.Cells(Rows.Count, c).End(xlUp).Row, c)).ClearContents
End If
End With
End If
Next sh2
With sh1
imax = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 6 To imax
If .Range("A" & i).Value <> "" Then
sname = .Range("D" & i).Value
Select Case sname
Case "lightening","fire","water", "leaf", "wind", "dragon"
Case Else
sname = ""
End If
End Select
If sname <> "" Then
Set sh2 = Worksheets(sname)
sh2.Cells(sh2.Cells(Rows.Count, c).End(xlUp).Row + 1, c).Value = .Cells(i, j + 4)
End If
End If
Next i
For i = 32 To 40
Set sh2 = Nothing
Select Case i
Case 1
Set sh2 = Worksheets("lightening")
Case 2
Set sh2 = Worksheets("fire")
Case 4
Set sh2 = Worksheets("water")
Case 6
Set sh2 = Worksheets("leaf")
Case 7
Set sh2 = Worksheets("wind")
Case 9
Set sh2 = Worksheets("dogagon")
End Select
If Not sh2 Is Nothing Then
.Cells(i, j + 4).Value = sh2.Cells(sh2.Cells(Rows.Count, c + 1).End(xlUp).Row, c + 1).Value
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox "ポケモン抽出コピペ終わり！"
End Sub

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

• 

  ご指摘ありがとうございます。
  早速直してまた実行してみましたが、最後のポケモン図鑑への貼り付けはされるのですが、ポケモン図鑑から他のシートへの抽出コピペがうまくいきませんでした。もうなんでなのかわからず迷走しております。

  No.1の回答に寄せられた補足コメントです。 補足日時：2017/05/19 10:09

• 

  ＞初心者レベルでいいので VBAについての勉強を先にすべきだと思います。
  うぐ、厳しい意見ありがとうございます。
  学校でhtmlやcssの勉強はしてまいりましたが、この課題に関しては普通のExcelの基礎講義の番外編といった感じに出されまして・・・まったく基礎が確かになってないですよね。正直見方や構文を調べてもいまいちピンと来ない状況で、ひとまずdragonに関しては修正できたのですが。
  アドバイスいただいた61行目の「End If」と 62行目の「End Select」の順番や67行目の「End If」はどこと以下同文・・・のあたりに関しては情けないことに全く理解できません。

  No.2の回答に寄せられた補足コメントです。 補足日時：2017/05/19 10:50

• 

  d-q-t-pさんへ
  アドバイスありがとうございます。
  でも、提出期限が今日の午後14時なのでとても自分の力量では組みなおすのが難しいです。

  No.3の回答に寄せられた補足コメントです。 補足日時：2017/05/19 13:07

No.2 ベストアンサー 回答者： d-q-t-p 回答日時： 2017/05/19 10:36

プログラム自体の動きは全くチェックしていません。

色々おかしいところがありますが 自分でデバッグくらいできるように
ならないとダメだと思います。

42行目と 50行目の「End If」はどこに掛かっていますか？
51行目の Next sh2はどこに掛かっていますか？
最後の方の「dogagon」てつづりは合ってますか？
61行目の「End If」と 62行目の「End Select」の順番は合ってますか？
67行目の「End If」はどこと以下同文

初心者レベルでいいので VBAについての勉強を先にすべきだと思います。

No.3 回答者： d-q-t-p 回答日時： 2017/05/19 11:48

直せなくはないですけど……

htmlの知識があるなら分かると思いますが タグは必ずネストしてい
かないといけませんよね。

For ～ Next
If ～ End if
With ～ End With

これらも同じです。位置を見直していって下さい。

正直なところ このプログラムを添削したところで 作りの悪さは残り
ます。どうもやりながら作っていったのかもしれませんが 最初の方
と最後の方でやり方も変わってしまっているように見えます。

面倒と思うかもしれませんが 調べて分かったことを前提にして最初
からやり直した方がいいものになると思いますよ。

No.1 回答者： GooUserラック 回答日時： 2017/05/19 10:03

良くは見ていませんが、最後の｢For～Next｣分の中の｢Select Case｣は｢i｣が32～40なので一度も該当しません。

もしかしたら｢For i = 32 To 40｣ではなく｢For j = 32 To 40｣なのでは？