Webimport

Sub Verteilen()
Dim col As New Collection
Dim wksS As Worksheet, wksT As Worksheet, wksK As Worksheet, wksL As Worksheet, wksM As Worksheet, wksN As Worksheet
Dim vRowS As Variant, vRowT As Variant, vRowK As Variant, vRowL As Variant, vRowM As Variant, vRowN As Variant
Dim iCounter As Integer
Dim sQ As String
Dim sP As String
Set wksS = Worksheets("Data")
Set wksT = Worksheets("Input")
Set wksK = Worksheets("DataNL")
Set wksL = Worksheets("DataFRA")
Set wksM = Worksheets("inputNL")
Set wksN = Worksheets("inputFRA")
For iCounter = 1 To 12
vRowS = Application.Match("Cal-" & Format(DateSerial(1, iCounter, 1), "mm"), wksS.Columns(2), 0)
If Not IsError(vRowS) Then
wksT.Cells(26 + iCounter, 15).Value = wksS.Cells(vRowS, 10).Value
wksT.Cells(64 + iCounter, 15).Value = wksS.Cells(vRowS + 8, 10).Value
End If
Next iCounter
For iCounter = 20 To 25
sQ = wksT.Cells(iCounter, 1).Value
vRowS = Application.Match(CLng(DateSerial(Right(Year(Date), 2), Right(sQ, 2), Mid(sQ, 2, 1))), wksS.Columns(2), 0)
If Not IsError(vRowS) Then
wksT.Cells(iCounter, 15).Value = wksS.Cells(vRowS, 10).Value
wksT.Cells(iCounter + 38, 15).Value = wksS.Cells(vRowS + 9, 10).Value
End If
Next iCounter
For iCounter = 1 To 12
vRowS = Application.Match("Cal-" & Format(DateSerial(1, iCounter, 1), "mm"), wksK.Columns(2), 0)
If Not IsError(vRowS) Then
wksT.Cells(26 + iCounter, 15).Value = wksS.Cells(vRowK, 3).Value
wksT.Cells(64 + iCounter, 15).Value = wksS.Cells(vRowK + 8, 3).Value
End If
Next iCounter
For iCounter = 20 To 25
sQ = wksT.Cells(iCounter, 1).Value
vRowS = Application.Match(CLng(DateSerial(Right(Year(Date), 2), Right(sQ, 2), Mid(sQ, 2, 1))), wksS.Columns(2), 0)
If Not IsError(vRowS) Then
wksM.Cells(iCounter, 15).Value = wksK.Cells(vRowS, 10).Value
wksM.Cells(iCounter + 38, 15).Value = wksK.Cells(vRowS + 9, 10).Value
End If
Next iCounter
End Sub