Macro copie-colle cases non vides

Bonjour, https://forum.excel-pratique.com/post/nouveau/2#

J'ai une macro qui copie plusieurs colonnes d'une feuille A à une feuille B.

C'est un tableau générique qui me permet de traiter des nomenclatures.

par défaut, ma macro copie les valeur des 2000 premières lignes, même si ma nomenclature à seulement 30 lignes. (j'ai mis 2000 pour avoir de la marge en cas de grosse nomenclature)

Voici le code de cette macro (PS, Merci ThauThème )

Private Sub Worksheet_Activate()
  With Sheets("Lecture des propriétées")
    .Range("B2:B2000").Copy
    Me.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    .Range("F2:F2000").Copy
    Me.Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    .Range("K2:K2000").Copy
    Me.Range("C2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    .Range("P2:P2000").Copy
    Me.Range("D2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    .Range("D2:E2000").Copy
    Me.Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    .Range("G2:J2000").Copy
    Me.Range("H2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    .Range("L2:O2000").Copy
    Me.Range("L2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
    Me.Range("Q2:U2000").Copy
    Range("P2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
  End With
End Sub

Ça marche bien, mais 2000 lignes, ça prends un peu de temps.

Comment modifier ce code pour ne sélectionner que les lignes qui ont une valeur non nulle dans la colonne B?

Le point noir étant que pour les autres colonnes copiées, il n'y a jamais de case non vide car elles renvoient le résultat de calcul basé sur la colonne B, avec comme résultat "#VALEUR!" si la colonne B est vide.

Ci dessous un extrait de mon tableau pour exemple:

Seul les lignes 2 à 10 m'interessent dans cet exemple, pas besoin de copier de 2 à 2000.

Bonjour,

Si j'ai bien compris:

pour déterminer la dernière ligne renseignée de la colonne B:

DerLig = .Range("B" & Rows.Count).End(xlUp).Row

pour copier (par colonne) jusqu"à la dernière ligne :

.Range("B2:B" & DerLig).Copy
...
.Range("F2:F" & DerLig).Copy
.../...

A+

Salut Legnano,
Salut AlgoPlus,

à l'aveugle...

Private Sub Worksheet_Activate()
'
Dim iRow%
'
Range("A2:Z" & Range("B" & Rows.Count).End(xlUp).Row).Value = ""
With Sheets("Lecture des propriétées")
    iRow = .Range("B" & Rows.Count).End(xlUp).Row
    For x = 1 To 8
        Range(Choose(x, "A", "B", "C", "D", "F", "H", "L", "P") & 2).Resize(iRow, Choose(x, 1, 1, 1, 1, 2, 4, 4, 5)).Value = _
            .Range(Choose(x, "B", "F", "K", "P", "D", "G", "L", "Q") & 2).Resize(iRow, Choose(x, 1, 1, 1, 1, 2, 4, 4, 5)).Value
    Next
End With
'
End Sub

Tu m'excuseras mais "propriétées", ça pique les yeux ! "Propriétés" serait de bon aloi comme disait Maître Capello...

A+

Bonjour,

Pour le fun !...

Cdlt.

Private Sub Worksheet_Activate()
Dim lastRow As Long
    With Sheets("Lecture des propriétés")
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        Me.Cells(2, 1).Resize(lastRow - 1).Value = .Cells(2, 2).Resize(lastRow - 1).Value
        Me.Cells(2, 2).Resize(lastRow - 1).Value = .Cells(2, 6).Resize(lastRow - 1).Value
        Me.Cells(2, 3).Resize(lastRow - 1).Value = .Cells(2, 11).Resize(lastRow - 1).Value
        Me.Cells(2, 4).Resize(lastRow - 1).Value = .Cells(2, 16).Resize(lastRow - 1).Value
        Me.Cells(2, 6).Resize(lastRow - 1, 2).Value = .Cells(2, 4).Resize(lastRow - 1, 2).Value
        Me.Cells(2, 8).Resize(lastRow - 1, 4).Value = .Cells(2, 7).Resize(lastRow - 1, 4).Value
        Me.Cells(2, 12).Resize(lastRow - 1, 4).Value = .Cells(2, 12).Resize(lastRow - 1, 4).Value
        Me.Cells(2, 16).Resize(lastRow - 1, 5).Value = .Cells(2, 17).Resize(lastRow - 1, 5).Value
    End With
End Sub

Merci AlgoPlus

Ton code marche a merveille. du coup j'ai pas testé les propositions de Curulis57 et Jean-Eric, mais je les remercie quand même.

Et désolé pour tes yeux Curulis, j'ai corrigé ça ; )

Erratum : il y à un petit problème :

quand colonne B est vide (rien dans B2 ni en dessous), la macro copie quand même la ligne 1 dans laquelle j'ai mes titres.Ça fait un peu le bazar dans mon calcul.

Y-a-t'il un moyen pour que la ligne 1 ne soit pas prise en compte?

Toujours à l'aveugle...

Private Sub Worksheet_Activate()
'
Dim iRow%, iNbCol%, sCol1$, sCol2$
'
With Sheets("Lecture des propriétés")
    For x = 1 To 8
        iNbCol = Choose(x, 1, 1, 1, 1, 2, 4, 4, 5)
        sCol1 = Choose(x, "A", "B", "C", "D", "F", "H", "L", "P")
        iRow = Range(sCol & Rows.Count).End(xlUp).Row
        If iRow > 1 Then Range(sCol & 2).Resize(iRow, iNbCol).Value = ""
        sCol2 = Choose(x, "B", "F", "K", "P", "D", "G", "L", "Q")
        iRow = .Range(sCol & Rows.Count).End(xlUp).Row
        If iRow > 1 Then Range(sCol1 & 2).Resize(iRow, iNbCol).Value = .Range(sCol2 & 2).Resize(iRow, iNbCol).Value
    Next
End With
'
End Sub

A+

Merci Curulis

J'ai pas testé ton codes pour le moment. en fait j'essaye de comprendre comment ca marche plutôt quee de le copier coller bêtement. Et là je ne vois pas bien comment il fonctionne... ça semble très différent du code d’origine, et j'ai peur de pas arriver à le modifier en cas de besoin.

Peux tu me mettre en 2 mot les fonctions de chaque ligne de code?

Ça y est, je viens de déchiffrer, je pense que ça va aller.

C'est un code "optimisé" on dirait. Moins de fonction, moins de caractères ! Mais moins transparent du coup.

Je vais tester ça.

Merci ;)

Ça bloque à ce niveau:

iRow = Range(sCol & Rows.Count).End(xlUp).Row

"erreur 1004 : la méthode 'range' de l'objet 'worcksheet' a échouée"

Oublié d'adapter partout les sCol avec leur "index"...

Private Sub Worksheet_Activate()
'
Dim iRow%, iNbCol%, sCol1$, sCol2$
'
With Sheets("Lecture des propriétés")
    Application.ScreenUpdating = False
    For x = 1 To 8
        iNbCol = Choose(x, 1, 1, 1, 1, 2, 4, 4, 5)
        sCol1 = Choose(x, "A", "B", "C", "D", "F", "H", "L", "P")
        iRow = Range(sCol1 & Rows.Count).End(xlUp).Row
        If iRow > 1 Then Range(sCol1 & 2).Resize(iRow, iNbCol).Value = ""
        sCol2 = Choose(x, "B", "F", "K", "P", "D", "G", "L", "Q")
        iRow = .Range(sCol2 & Rows.Count).End(xlUp).Row
        If iRow > 1 Then Range(sCol1 & 2).Resize(iRow, iNbCol).Value = .Range(sCol2 & 2).Resize(iRow, iNbCol).Value
    Next
    Application.ScreenUpdating = True
End With
'
End Sub

A+

Parfait !

Quel gain de temps !

Merci beaucoup

Bon par contre je comprends pas comment ca marche. et comme prévu, j'arrive pas à le modifier.

Je peux avoir un peu d'explications?

'

Private Sub Worksheet_Activate() <code><b><i>active la macro lors de la selection de la feuille

Dim iRow%, iNbCol%, sCol1$, sCol2$ Indique les variables à définir

'

With Sheets("Lecture des propriétés") Indique dans quelle feuille copier

Application.ScreenUpdating = False ?

For x = 1 To 8 ?

iNbCol = Choose(x, 1, 1, 1, 1, 2, 4, 4, 5) Nombre de colonnes selectionné pour chaques « section »

sCol1 = Choose(x, "A", "B", "C", "D", "F", "H", "L", "P") Colonnes où coller

iRow = Range(sCol1 & Rows.Count).End(xlUp).Row ?

If iRow > 1 Then Range(sCol1 & 2).Resize(iRow, iNbCol).Value = "" ?

sCol2 = Choose(x, "B", "F", "K", "P", "D", "G", "L", "Q") 1ere Colonnes de chaque « section » à copier

iRow = .Range(sCol2 & Rows.Count).End(xlUp).Row ?

If iRow > 1 Then Range(sCol1 & 2).Resize(iRow, iNbCol).Value = .Range(sCol2 & 2).Resize(iRow, iNbCol).Value ?

Next

Application.ScreenUpdating = True ?

End With

'

End Sub

Salut Legnano,

t'inquiètes pas, tout le monde est passé par là : c'est en forgeant qu'on devient forgeron !

Private Sub Worksheet_Activate()
'
'on suppose donc que les modifs' doivent être effectuées sur CETTE feuille activée
'on va chercher les nouvelles infos sur 'Propriétés' -> WITH
Dim iRow%, iNbCol%, sCol1$, sCol2$
'
With Sheets("Lecture des propriétés")
    Application.ScreenUpdating = False  'neutralise la mise à jour de l'affichage à l'écran
    For x = 1 To 8  'puisque tu copies 8 colonnes (extensibles ou pas)
        iNbCol = Choose(x, 1, 1, 1, 1, 2, 4, 4, 5)  'détermine le nombre de colonnes de chaque copie
        sCol1 = Choose(x, "A", "B", "C", "D", "F", "H", "L", "P")   'détermine la colonne recevant la copie
        iRow = Range(sCol1 & Rows.Count).End(xlUp).Row  'calcule la hauteur actuelle de la colonne de réception des nouvelles données
        If iRow > 1 Then Range(sCol1 & 2).Resize(iRow, iNbCol).Value = ""   'si cette colonne n'est pas vide, donc que, par ex, [A2] n'est pas vide, on nettoie
        sCol2 = Choose(x, "B", "F", "K", "P", "D", "G", "L", "Q")   'détermine la colonne avec les nouvelles données
        iRow = .Range(sCol2 & Rows.Count).End(xlUp).Row 'calcule la hauteur de cette colonne
        If iRow > 1 Then Range(sCol1 & 2).Resize(iRow, iNbCol).Value = .Range(sCol2 & 2).Resize(iRow, iNbCol).Value 'si présence de données à copier -> copie
    Next
    Application.ScreenUpdating = True   'actualisation de l'affichage
End With
'
End Sub

A+

Et donc si je veux copier une seul colonne (étendu a 15 colonnes par exemple) , je peux mettre

"for x = 1" (au lieu de "for x = 1 To 8")

"iNbCol = choose (x, 15)"

"sCol1 = choose (x, A)"

"sCol2 = choose (x, B)"

J'ai bon? demain je teste pour voir

Si ce n'est qu'UNE colonne (extensible ou pas) à copier, plus besoin de la boucle FOR...
Dans ton "exemple" :

Private Sub Worksheet_Activate()
'
Dim iRow%
'
With Sheets("Lecture des propriétés")
    Application.ScreenUpdating = False  'neutralise la mise à jour de l'affichage à l'écran
    iRow = Range("A" & Rows.Count).End(xlUp).Row  'calcule la hauteur actuelle de la colonne de réception des nouvelles données
    If iRow > 1 Then Range("A2").Resize(iRow, 15).Value = ""   'si cette colonne n'est pas vide, donc que, par ex, [A2] n'est pas vide, on nettoie
    iRow = .Range("B" & Rows.Count).End(xlUp).Row 'calcule la hauteur de cette colonne
    If iRow > 1 Then Range("A2").Resize(iRow, 15).Value = .Range("B2").Resize(iRow, 15).Value 'si présence de données à copier -> copie
    Application.ScreenUpdating = True   'actualisation de l'affichage
End With
'
End Sub

Haut les coeurs, ça va aller !

A+

Bonjour a tous

J'ai dû laisser tomber mon projet pendant quelques jours, et quand j'y reviens, forcement, ça coince un peu.

J'ai modifié mon tableau afin de n'avoir qu'une seul section à coller.

J'ai essayé de modifier la macro pour m'adapter à ce changement, mais malgré les explication en vert dans le code, je ne m'y retrouve pas.

Je ne comprends toujours pas où est encodé :

• La colonne ou compter le nombre de ligne non vides -> OK
• l'exclusion de la première ligne pour ne pas prendre en compte le titre des colonnes
• la section à copier -> OK
• l'endroit où coller -> OK
• accessoirement pourquoi cette fonction "si cette colonne n'est pas vide, on la nettoie"
• accessoirement pourquoi cette fonction "calcule la hauteur actuelle de la colonne de réception des nouvelles données"

Donc pour résumer mon besoin à jour -> OK

• quand j’active la feuille "Modification des propriétés" je voudrais: -> OK
• compter dans la feuille "Lecture des propriétés", le nombre de lignes non vide, exception faite de la 1ere ligne, dans la colonne B -> OK
• sélectionner une zone correspondant à ces lignes, de la colonne B à U (20 colonnes) -> OK
• coller les valeurs de ces cellules dans la feuille "Modification des propriétés" à partir de la cellule B2 -> OK

Si j'arrive a comprendre, promis, j'arrête de vous embêter

J'y suis presque: j'ai dû trouver le bon paramètres.

Il ne reste q'une erreur que je n'avais pas avant : il y a une ligne en trop collée...

J'ai codé comme ceci :

Private Sub Worksheet_Activate()
'
Dim iRow%
'
With Sheets("Lecture des propriétés")
    Application.ScreenUpdating = False  'neutralise la mise à jour de l'affichage à l'écran
    iRow = Range("B" & Rows.Count).End(xlUp).Row  'calcule la hauteur actuelle de la colonne de réception des nouvelles données
    If iRow > 1 Then Range("B2").Resize(iRow, 20).Value = ""   'si cette colonne n'est pas vide, donc que, par ex, [B2] n'est pas vide, on nettoie
    iRow = .Range("B" & Rows.Count).End(xlUp).Row 'calcule la hauteur de cette colonne
    If iRow > 1 Then Range("B2").Resize(iRow, 20).Value = .Range("B2").Resize(iRow, 20).Value 'si présence de données à copier -> copie
    Application.ScreenUpdating = True   'actualisation de l'affichage
End With
'
End Sub

Et aussi, j'aimerais réinitialiser tout les filtres (sélectionner tout) avant de réaliser la copie, car ça me crée des bug