VBA Excel Copier lignes avec colonnes définies

Résolu
Joh67 Messages postés 7 Date d'inscription   Statut Membre Dernière intervention   -  
ccm81 Messages postés 10909 Date d'inscription   Statut Membre Dernière intervention   -
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!

A voir également:

2 réponses

ccm81 Messages postés 10909 Date d'inscription   Statut Membre Dernière intervention   2 433
 
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
0
Joh67 Messages postés 7 Date d'inscription   Statut Membre Dernière intervention  
 
Merci ccm81, tu es un génie, au top!
ça vient d'égayer ma semaine!
0
ccm81 Messages postés 10909 Date d'inscription   Statut Membre Dernière intervention   2 433
 
De rien

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

Bonne soirée
0