Transpose avec condition
laucsap27
Messages postés
1
Date d'inscription
mardi 23 août 2016
Statut
Membre
Dernière intervention
23 août 2016
-
Modifié par laucsap27 le 23/08/2016 à 11:44
Eric4577 Messages postés 2 Date d'inscription dimanche 25 septembre 2016 Statut Membre Dernière intervention 17 mai 2017 - 25 sept. 2016 à 12:28
Eric4577 Messages postés 2 Date d'inscription dimanche 25 septembre 2016 Statut Membre Dernière intervention 17 mai 2017 - 25 sept. 2016 à 12:28
1 réponse
Eric4577
Messages postés
2
Date d'inscription
dimanche 25 septembre 2016
Statut
Membre
Dernière intervention
17 mai 2017
25 sept. 2016 à 12:28
25 sept. 2016 à 12:28
Bonjour à tous
Bonjour laucsap27
Je ne connais pas l'efficacité de ce code sur 12000 lignes.
J'ai gardé la première ligne pour :
nom, critère, nom,1,2,3,4,......11
et c'est pour la "Feuil1".
A toi d'adapter
Tu dis
Eric
Bonjour laucsap27
Je ne connais pas l'efficacité de ce code sur 12000 lignes.
Option Explicit
Sub essai_01()
Dim premlign As Integer
Dim derlign As Long
Dim i As Long
Dim c As Range
Dim firstAddress As String
Dim ligne As Integer
premlign = 2
derlign = Range("A" & premlign).End(xlDown).Row
For i = premlign To derlign
With Worksheets("Feuil1").Range("C2:C65536")
Set c = .Find(Range("A" & i), LookIn:=xlValues, Lookat:=xlWhole)
If c Is Nothing Then
If Range("C2") = "" Then
Range("C2") = Range("A" & i)
ligne = 2
Else
Range("C" & Range("C1").End(xlDown).Row + 1) = Range("A" & i)
ligne = Range("C1").End(xlDown).Row
End If
Else
ligne = c.Row
End If
Cells(ligne, CInt(Trim(Right(Range("B" & i), Len(Range("B" & i)) - 1))) + 3) = Range("B" & i)
End With
Next i
End Sub
J'ai gardé la première ligne pour :
nom, critère, nom,1,2,3,4,......11
et c'est pour la "Feuil1".
A toi d'adapter
Tu dis
Eric
