Microsoft 365 Copie de cellules non adjacentes en Vba

[Thierry054]

Bonjour,
Je suis tout nouveau sur ce forum et débutant en Vba.
J'ai tenté de trouver la réponse à mon problème dans le forum et sur le net mais je n'ai pas trouvé de solution qui me permette de le résoudre.
Je vous joins mon fichier exemple pour lequel un collègue m'a déjà aidé sur la macro.
Il comporte 2 feuilles :
- la feuille 1 est la source des données
- la feuille 2 est celle dans laquelle copier les données.

Je souhaite, pour chaque ligne qui comporte un caractère en colonne H copier les données présentes en colonnes A, B, F, G.
Ma macro fonctionne pour recopier toutes les colonnes mais je ne trouve pas comment faire pour ne copier que les colonnes ci-dessus...

 

[mapomme]

Re,

Je pensais que tu avais écrit 40 000 au lieu de 400 000 . Je vais voir demain samedi ce qu'il en est avec 40 000 lignes.

Juste pour le fun (ce n'est pas la méthode la plus rapide), une procédure qui n'utilise que des "manipulations Excel".

Sub ViaExcel()
Dim max&, deb
   deb = Timer: Application.ScreenUpdating = False
   With Sheets("Feuil1")
      Sheets("Feuil2").Columns("a:e").ClearContents
      max = .Range("a1").CurrentRegion.Rows.Count
      .Range("a:d").Resize(max).Copy Sheets("Feuil2").Range("a1")
   End With
   With Sheets("Feuil2")
      .Columns("e:e").Resize(max).Formula = "=IF(ROUND(RC[-2],2)<>ROUND(RC[-1],2),0,#N/A)"
      .Columns("e:e").Resize(max).Value = .Columns("e:e").Resize(max).Value
      [e1] = 0
      .Columns("a:e").Resize(max).Sort key1:=.Range("e1"), order1:=xlAscending, Header:=xlYes
      On Error Resume Next
      .Columns("e:e").Resize(max).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Resize(, 5).Delete
      .Columns("e:e").Resize(max).ClearContents
   End With
   MsgBox "C'est fini en : " & Format(Timer - deb, "#0.00\ sec.")
End Sub

 

[RyuAutodidacte]

Re,

Je pensais que tu avais écrit 40 000 au lieu de 400 000 . Je vais voir demain samedi ce qu'il en est avec 40 000 lignes.

Juste pour le fun (ce n'est pas la méthode la plus rapide), une procédure qui n'utilise que des "manipulations Excel".

Sub ViaExcel()
Dim max&, deb
   deb = Timer: Application.ScreenUpdating = False
   With Sheets("Feuil1")
      Sheets("Feuil2").Columns("a:e").ClearContents
      max = .Range("a1").CurrentRegion.Rows.Count
      .Range("a:d").Resize(max).Copy Sheets("Feuil2").Range("a1")
   End With
   With Sheets("Feuil2")
      .Columns("e:e").Resize(max).Formula = "=IF(ROUND(RC[-2],2)<>ROUND(RC[-1],2),0,#N/A)"
      .Columns("e:e").Resize(max).Value = .Columns("e:e").Resize(max).Value
      [e1] = 0
      .Columns("a:e").Resize(max).Sort key1:=.Range("e1"), order1:=xlAscending, Header:=xlYes
      On Error Resume Next
      .Columns("e:e").Resize(max).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Resize(, 5).Delete
      .Columns("e:e").Resize(max).ClearContents
   End With
   MsgBox "C'est fini en : " & Format(Timer - deb, "#0.00\ sec.")
End Sub

Mea culpa , je viens de me rendre compte que c'est bien 400 000, mes yeux mon joués des tours, voilà ce qui arrive qd on travail trop; c'est vrai que le chiffre de la message box m'a pas aidé quand j'ai ouvert le fichier :

bon au moins c'est pas un bug sur Mac c'est déjà ça
désolé …

 

[RyuAutodidacte]

J'ai vérifié mes variables locales : on a bien 80 000 et des poussières :

Autant pour moi

 

[mapomme]

Mea culpa , je viens de me rendre compte que c'est bien 400 000, mes yeux mon joués des tours, voilà ce qui arrive qd on travail trop; c'est vrai que le chiffre de la message box m'a pas aidé quand j'ai ouvert le fichier :

Non c'est à moi de battre ma coulpe. Je n'ai pas vu qu'un 0 a sauté. J'ai remplacé le fichier en cause par un fichier avec le bon message. Mille excuses pour cette bévue .

 

[Staple1600]

Bonjour le fil

Sinon puisque Office365, sans macro et sans pantalons salut à toi, Rika
Cette simple formule fait le job
=CHOISIRCOLS(FILTRE(Feuil1!A1:H150;Feuil1!H1:H150="x");1;2;6;7)

 

[mapomme]

Bonjour @Staple1600 ,

J'avions point fait attention que le demandeur utilisait en O365 .

 

[Staple1600]

Bonjour @mapomme

Et le demandeur n'a pas fait attention qu'il avait de nouvelles réponses dans sa discussion depuis le 14 mai.
Pas sur qu'il tombe sur ma formule ou mon pantalon