1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
| Sub copypjointes()
Dim repere As String
Dim dernl As Range, liste As Range
Dim f As Range
Dim nbcol As Integer
Dim p As Integer, k As Integer, a As Byte
Dim Tablo()
Dim dernval As Range
'Occurence à rechercher dans la colonne 1 de la feuille "TABLE"
repere = cmboTAG.Value
With Sheets("MASTER LUT")
'Dernière ligne de la feuille "TABLE"
Set dernl = .Cells(.Rows.Count, 5).End(xlUp)
'liste des occurences dans laquelle chercher la valeur de la Combobox
Set liste = .Range(.Cells(9, 5), dernl)
'Cellule correspondante à la recherche
Set f = liste.Find(repere, Lookat:=xlWhole)
'Dernière colonne de la feuille "TABLE"
nbcol = .Cells(9, .Columns.Count).End(xlToLeft).Column - 1
'Compteur des occurences informées
k = 0
'Il y a 3 champs (...) placés toutes les colonnes à partir de la colonne des occurences (A1, A2...)
For p = 85 To nbcol
'Test si le champ est informé
If f.Offset(0, p) > 1 Then
'Si oui, alors le compteur augmente de 1
k = k + 1
'On redimensionne la variable Tableau de 1 occurence k tout en conservant les précédents enregistremeents
'Il y a 4 champs à retenir (Nom de la pièce, Référence, Quantité N, Quantité D)
ReDim Preserve Tablo(1 To 3, 1 To k)
'1ère valeur = nom de la pièce placé en ligne 5
Tablo(1, k) = .Cells(9, 5 + p)
'Référence
Tablo(2, k) = f.Offset(0, p)
End If
Next p
End With
'Information de la feuille Résultats
With Sheets("11-PIECES JOINTES")
'Effacement des anciens enregistrements...
Set dernval = .Cells(.Rows.Count, 5).End(xlUp)
'... à conditions qu'il y en ait, sinon on effacerait la ligne de titres
If dernval.Row > 7 Then .Range("A7", dernval.Offset(0, 6)).ClearContents
'On informe le champ correspondant à la variable Tableau transposée
If UBound(Tablo(), 2) <= 40 Then
.Range("A7").Resize(UBound(Tablo(), 2), UBound(Tablo(), 1)).Value = WorksheetFunction.Transpose(Tablo)
Else
For p = 1 To 40
With .Range("A7")
.Offset(p - 1, 0) = Tablo(1, p)
.Offset(p - 1, 1) = Tablo(2, p)
End With
Next p
For p = 41 To 81
With .Range("F7")
.Offset(p - 41, 0) = Tablo(1, p)
.Offset(p - 41, 1) = Tablo(2, p)
End With
Next p
For p = 82 To UBound(Tablo(), 2)
With .Range("K7")
.Offset(p - 82, 0) = Tablo(1, p)
.Offset(p - 82, 1) = Tablo(2, p)
End With
Next p
End If
End With |
Partager