VBA Excel Copier lignes avec colonnes définies
Résolu
Joh67
Messages postés
7
Statut
Membre
-
ccm81 Messages postés 11033 Statut Membre -
ccm81 Messages postés 11033 Statut Membre -
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!
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
-
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 -
De rien
Si c'est fini, peux tu mettre le sujet à résolu (en haut à droite, la roue dentée)
Bonne soirée
