VBA Excel Copier lignes avec colonnes définies [Résolu/Fermé]

Signaler
Messages postés
7
Date d'inscription
lundi 4 juin 2018
Statut
Membre
Dernière intervention
29 août 2018
-
Messages postés
9579
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
16 octobre 2020
-
Bonjour,

Je débute en VBA et je souhaite améliorer ma macro.
Actuellement ma macro copie les lignes "complètes" selon la valeur d'une colonne définie (colonne AF dans mon cas).
Je souhaiterai copier uniquement certaines colonnes (ex: A, C, E, F, G, I, L, O, Q, R, U...) et non plus toutes les colonnes!

Voici ma macro:

Sub Macro1()

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("Laser3D").Activate ' feuille de destination
Sheets("Laser3D").Select Cells.ClearContents ' effacer valeur précédentes
Col = "AF" ' colonne de la donnée non vide à tester
NumLig = 0
With Sheets("Data") ' feuille source
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig

If .Cells(Lig, Col).Value <> "" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste
End If

Next

End With

End Sub


J'ai essayé de remplacer l'étape ".Cells(Lig, Col).EntireRow.Copy" en précisant ".Cells(Lig, Col).Column ("....").Copy" mais sans succès, je ne dois pas avoir la bonne syntaxe...

Quelqu'un aurait une idée?

Merci d'avance!

2 réponses

Messages postés
9579
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
16 octobre 2020
1 926
Bonjour

Essaies ceci

' liste des colonnes à copier
Const listecol = "A,C,E,F,G,I,L,O,Q,R,U"

Sub Macro1()
Dim Lig As Long
Dim Col As String
Dim DerLig As Long
Dim NumLig As Long
Dim tabcol, co As Long
' slittage de la listecol dans tabcol (à base 0)
tabcol = Split(listecol, ",")
Col = "AF" ' colonne de la donnée non vide à tester
NumLig = 0
With Sheets("Data") ' feuille source
  DerLig = .Cells(Rows.Count, Col).End(xlUp).Row
  For Lig = 1 To DerLig
    If .Cells(Lig, Col).Value <> "" Then
      NumLig = NumLig + 1
      For co = 0 To UBound(tabcol)
        Sheets("Laser3D").Cells(NumLig, 1 + co).Value = .Cells(Lig, tabcol(co))
      Next co
    End If
  Next
End With
End Sub

Cdlmnt
Messages postés
7
Date d'inscription
lundi 4 juin 2018
Statut
Membre
Dernière intervention
29 août 2018

Merci ccm81, tu es un génie, au top!
ça vient d'égayer ma semaine!
Messages postés
9579
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
16 octobre 2020
1 926
De rien

Si c'est fini, peux tu mettre le sujet à résolu (en haut à droite, la roue dentée)

Bonne soirée