Mouvement de Cellules

Question

&#91;Sous Excel 2007 / 2010&#93; J'ai un souci de mouvement de cellules, je m'explique j'ai une transposition de cellule à faire en fonction de valeur de colonnes référence. J'ai environ 15000 à 20000 lignes. J'ai beau essayer de transposer de faire des décalage de lignes etc etc bref je ne m'en sort pas et impossible de gérer 20000 lignes comme ça Les couleurs dans les cellules ne sont là que pour le forum pour plus de clarté Si vous avez une petite routine pour faire ça, ça serait vraiment un grand pas en avant pour moi dans ce monde vba !!! j'avance mais là je bloque, j'arrive à faire mes tris et mes collage dans la feuil2 mais si la ref de la feuille "liste" en colonne A contient une seconde valeur identique, par exemple en A2 j'ai 10001 puis en A3 10001 aussi je n'arrive pas à traiter cette ligne je passe en A4 ! Pour info j'increment une variable incr sur 10000 + incr mon code : Sub ref_100000_Feuil2() Dim lig As Integer Dim ligliste As Integer Dim col As Integer Dim txt As Double Dim NBref As Integer Dim incr As Integer Application.ScreenUpdating = False 'MsgBox Oui + Non Select Case MsgBox("effacer Feuil2 et les X ?", vbYesNo, "effacer Feuil2 ?") Case vbYes Sheets("liste").Select Range("D:D").ClearContents Sheets("Feuil2").Select Range("A:ZZ").ClearContents Sheets("liste").Select Case vbNo End Select incr = 0 For ligliste = 2 To 65 Sheets("liste").Select Range("A2").Select If Cells(ligliste, 1) = "" And liglist &lt; 65 Then Range("D:D").ClearContents 'ElseIf liglist = 62 Then ElseIf Cells(ligliste, 1) = "fin" Then MsgBox "fin de colonne" Exit Sub End If ' 10000X If Cells(ligliste, 1).Text = "10000" &amp; incr And Cells(ligliste, 4) = "" Then ' "X" =&gt; "pour valider ce qui est fait" Cells(ligliste, 4) = "X" txt = "10000" &amp; incr NBref = Application.WorksheetFunction.CountIf(Range("A:A"), "=" &amp; txt) Range(Cells(ligliste, 1), Cells(ligliste, 3)).Copy ' FEUIL2 Sheets("Feuil2").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False For lig = 3 To 255 If Cells(lig, 1) = "" Or Cells(lig, 1) = Range("A1") Then Cells(lig, 1) = Range("A1") For col = 2 To 255 Step 2 If Cells(lig, col) = Range("A1") Then Cells(lig, col + 1) = Cells(lig, col + 1) Exit For ElseIf Cells(lig, col) = "" Then Cells(lig, col) = Range("B1") Cells(lig, col + 1) = Range("C1") Exit For Else Cells(lig, col + 2).Select End If Next col Range("A1:C1").ClearContents Exit For Else Cells(lig + 1, col).Select End If Next lig Cells(ligliste + 1, 1).Select End If 'incr = incr + 1 Next ligliste Application.ScreenUpdating = True End Sub Merci...

Invité · Accepted Answer

Re,

En général je ne reviens pas sur la demande initiale et le code que j'ai fait

Mais bon, tu es débutant je veux bien t'excuser pour cette fois

Essaye ce code

Sub Tri()
  Dim DLig As Long, Lig As Long, LigF As Long, NCol As Long
  Dim Ref As String, ShtS As Worksheet
  ' Définir la feuille source
  Set ShtS = Sheets("Liste")
  ' Dernière ligne de la feuille Source
  DLig = ShtS.Range("A" & Rows.Count).End(xlUp).Row
  ' Avec la feuille sur laquelle on veut travailler
  With Sheets("Feuil2")
    .Activate
    ' Pour chaque ligne
    For Lig = 2 To DLig
      Ref = ShtS.Range("A" & Lig).Value
      ' En cas d'erreur on continue
      On Error Resume Next
      ' Chercher la ligne correspondante
      LigF = 0
      LigF = .Range("A:A").Find(What:=Ref, LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
      ' Si la ligne est trouvée
      If LigF <> 0 Then
        ' Calculer la prochaine colonne de la ligne
        NCol = .Cells(LigF, Columns.Count).End(xlToLeft).Offset(0, 1).Column
        ' La nouvelle colonne doit être un multiple de 3
        NCol = IIf(NCol / 3 <> Int(NCol / 3), Round((NCol / 3) + 0.5) * 3, NCol) + 1
      Else
        ' Calculer la prochaine ligne vide
        LigF = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
        ' La colonne est la 1ère
        NCol = 1
      End If
      ' Copier coller les éléments
      ShtS.Range("A" & Lig).Resize(, 3).Copy Destination:=.Cells(LigF, NCol)
    Next Lig
  End With
End Sub

A+

Invité · Answer

Essaye ce code et dis nous si cela te convient Sub Tri() Dim DLig As Long, Lig As Long, LigF As Long, NCol As Long Dim Ref As String, ShtS As Worksheet ' Définir la feuille source Set ShtS = Sheets("Liste") ' Dernière ligne de la feuille Source DLig = ShtS.Range("A" &amp; Rows.Count).End(xlUp).Row ' Avec la feuille sur laquelle on veut travailler With Sheets("Feuil2") .Activate ' Pour chaque ligne For Lig = 2 To DLig Ref = ShtS.Range("A" &amp; Lig).Value ' En cas d'erreur on continue On Error Resume Next ' Chercher la ligne correspondante LigF = 0 LigF = .Range("A:A").Find(What:=Ref, LookIn:=xlValues, LookAt:=xlWhole, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row ' Si la ligne est trouvée If LigF &lt;&gt; 0 Then ' Calculer la prochaine colonne de la ligne NCol = .Cells(LigF, Columns.Count).End(xlToLeft).Offset(0, 1).Column Else ' Calculer la prochaine ligne vide LigF = .Range("A" &amp; Rows.Count).End(xlUp).Offset(1, 0).Row ' La colonne est la 1ère NCol = 1 End If ' Copier coller les éléments ShtS.Range("A" &amp; Lig).Resize(, 3).Copy Destination:=.Cells(LigF, NCol) Next Lig End With End Sub A+...