Salut,
Rapidement tu peux commencer par stocker tes 4 valeurs dans un tableau pour effectivement écrire qu'une fois dans le classeur .
Par exemple :
Dim T ' à déclarer au debut
Dim I&
redim T(1 to 4,1 to 1)
I=1
'*** CONDITION QUI VA DÉFINIR "repère" *****************
For Each Row In Worksheets("AllData").Cells(1, 1).CurrentRegion.Rows
....
...
Else
redim prerserve T(1 to 4, 1 to I)
Value_domain = Cells(linklin1, 120)
Unit = Cells(linklin1, 121)
Name = Cells(linklin1, 12)
à remplacer par
T(0,i)=Cells(linklin1, 12)
T(1,i) = scade_name
T(2,i) = Cells(linklin1, 120)
T(3,i)=Cells(linklin1, 121)
i=i+1
..*
next row
'Ici on écrit qu'une fois
Workbooks("ICD_Avionique_COM").Sheets("ANA sortie").Range("A" & lignprov).resize(ubound(t,2),4)=transposegrandtab(t) 'Elle est définis la variable Lignprov ??????
end sub
Function TransposeGrandTab(T) 'Zon
'Application.transpose est limité à 5000 et qques éléments jusqu'à XL2002
Dim Temp, I&, J&, Z As Byte, Nb As Byte
On Error Resume Next
Do
Nb = Nb + 1
Z = UBound(T, Nb + 1)
Loop Until Err
If Nb = 1 Then
ReDim Temp(UBound(T), 1 To 1)
For I = LBound(T) To UBound(T)
Temp(I, 1) = T(I)
Next I
Else
ReDim Temp(1 To UBound(T, 2), 1 To UBound(T, 1))
For I = 1 To UBound(T, 2)
For J = 1 To UBound(T, 1)
Temp(I, J) = T(J, I)
Next J
Next I
End If
TransposeGrandTab = Temp
End Function
Avec des données exemple on pourrait peut être même faire un find sur "/CPIOM_G1/" au lieu de faire du cellule par cellule, faire un boucle While ....
A+++