VBA Excel Copier lignes avec colonnes définies

Résolu/Fermé

Joh67 Messages postés 7 Date d'inscription lundi 4 juin 2018 Statut Membre Dernière intervention 29 août 2018 - 4 juin 2018 à 14:34
ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 - 4 juin 2018 à 20:35

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:

VBA Excel Copier lignes avec colonnes définies
Liste déroulante excel - Guide
Aller à la ligne excel - Guide
Déplacer une colonne excel - Guide
Formule excel - Guide
Copier une vidéo youtube - Guide

2 réponses

Réponse 1 / 2

ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
4 juin 2018 à 15:46

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

Joh67 Messages postés 7 Date d'inscription lundi 4 juin 2018 Statut Membre Dernière intervention 29 août 2018
4 juin 2018 à 18:39

Merci ccm81, tu es un génie, au top!
ça vient d'égayer ma semaine!

Réponse 2 / 2

ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
4 juin 2018 à 20:35

De rien

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

Bonne soirée

Discussions similaires

Dessiner avec son clavier et avec des lettres

Afficher toutes les lignes masquées excel

Discussions similaires

Newsletters