マクロ初心者です、シートを変える手法ないでしょうか？下記コードがダサすぎて自分が嫌に

マクロ初心者です、シートを変える手法ないでしょうか？下記コードがダサすぎて自分が嫌になっています。。。雑すぎというのも理解していますが・・・
もっとシンプルに仕上げたいのですが何かないでしょうか？ご教示お願いします。

Sub 単月データ読込()

Dim ws As String
Dim val As String

Dim k
k = 11
Dim l
l = 12
Dim m
m = 13

ws = "今年度一覧"
val = "201605"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201606"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201607"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201608"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201609"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201610"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201611"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201612"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201701"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201702"
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

ws = "今年度一覧"
val = "201703"
Call shiteidata(ws, val, k, l, m)

MsgBox "処理が完了しました。"

End Sub

Sub shiteidata(ByVal ws As String, ByVal val As String, ByVal k As Long, ByVal l As Long, ByVal m As Long)

Dim w
Set w = Worksheets(ws)

Dim i '201605の行カウント
i = 8

Dim n '今年度一覧の行カウント
n = 8

w.Select

Do Until Worksheets(val).Cells(i, 1) = ""


If Worksheets(val).Cells(i, 1) = "" Then

Else
If w.Range("b" & n).Value = Worksheets(val).Cells(i, 2).Value Then '今年度一覧のコード1が201605のコード1と同じ

w.Cells(n, k).Value = Worksheets(val).Cells(i, 5).Value
w.Cells(n, l).Value = Worksheets(val).Cells(i, 6).Value
w.Cells(n, m).Value = w.Cells(n, k).Value - w.Cells(n, l).Value

' w.Range("k" & n).Value = Worksheets(val).Cells(i, 5).Value
' w.Range("l" & n).Value = Worksheets(val).Cells(i, 6).Value
' w.Range("m" & n).Value = w.Range("k" & n).Value - w.Range("l" & n).Value
n = 8
i = i + 1
Else '今年度一覧のコード1が201605のコード1と違う
If w.Range("a" & n) = "" Then

n = Cells(Rows.Count, 1).End(xlUp).Row + 1 ' ｎに最終行を入れて書込む行を最終行にする
w.Range("b" & n).Value = Worksheets(val).Cells(i, 2).Value
w.Range("c" & n).Value = Worksheets(val).Cells(i, 3).Value
w.Range("d" & n).Value = Worksheets(val).Cells(i, 4).Value

w.Cells(n, k).Value = Worksheets(val).Cells(i, 5).Value
w.Cells(n, l).Value = Worksheets(val).Cells(i, 6).Value
w.Cells(n, m).Value = w.Cells(n, k).Value - w.Cells(n, l).Value

' w.Range("k" & n).Value = Worksheets(val).Cells(i, 5).Value
' w.Range("l" & n).Value = Worksheets(val).Cells(i, 6).Value
' w.Range("m" & n).Value = w.Range("k" & n).Value - w.Range("l" & n).Value

w.Range("a" & n).Value = n - 7
w.Range("a" & n).Resize(1, 43).Borders.LineStyle = xlContinuous

i = i + 1
n = 8
Else
n = n + 1

End If
End If
End If
Loop

w.AutoFilterMode = False 'フィルタ結果を取得したので解除

' Application.ScreenUpdating = False
w.Select
Range("A3").Select

End Sub

No.1 ベストアンサー 回答者： t_fumiaki 回答日時： 2016/06/17 10:58

Sub 単月データ読込()

Dim ws As String
Dim val As String
Dim i As long
Dim 年 As long
Dim 月 As long

k = 11
Dim l
l = 12
Dim m
m = 13
ws = "今年度一覧"
年=2016
月=5

For i = 1 to 11

val = 年 & left("0" & 月,2)
Call shiteidata(ws, val, k, l, m)

k = k + 3
l = l + 3
m = m + 3

月=月+1

if 月=13 then
年=2017
月=1
End if

Next i
MsgBox "処理が完了しました。"

End Sub

この回答へのお礼

ありがとうございます！
こんなシンプルにできるんですね！！
超すごいですっ！
ちょっと分析してみます！

お礼日時：2016/06/17 14:15

No.2 回答者： t_fumiaki 回答日時： 2016/06/17 11:00

間違いあり。

val = 年 & left("0" & 月,2)
↓
val = 年 & Right("0" & 月,2)