Sub Transfeert_Données()
Dim FDon As Worksheet 'feuille données
Dim FTab As Worksheet 'feuille tableaux
Dim i As Integer
Dim TVar As Variant
Dim Col As Byte ' Colonne à remplir
Dim Lig As Integer 'ligne à remplir dans données
Dim Plus As Integer 'valeur à ajouter à ligne selon Poste, Bois...
'ColA = Array("Poste", "Bois", "Fer", "Paille") ' A voir
Set FDon = Sheets("Données")
Set FTab = Sheets("Janvier")
For i = 3 To FDon.Cells(Application.Rows.Count, 2).End(xlUp).Row
TVar = FDon.Range("B" & i & ":F" & i)
If CStr(TVar(1, 3)) = "Marc" Then Lig = 4 Else Lig = 12
Col = CByte(Left(TVar(1, 4), 2)) + 1
Select Case TVar(1, i - 2)
Case "Poste"
Plus = 1
Case "Bois"
Plus = 2
Case "Paille"
Plus = 3
End Select
FTab.Cells(Lig + Plus, Col) = TVar(1, 2)
Next i
End Sub