Copier à premières lignes vides

Résolu/Fermé
Patrick50 - 22 oct. 2015 à 15:38
 Patrick50 - 23 oct. 2015 à 16:09
Bonjour,


Je dois réaliser une macro consistant à :

- copier A1:E1 et coller cette plage en collage spécial valeur à la première ligne vide de la plage L100:Q2000

- puis copier Q1 et coller cette cellule en collage spécial valeur à la 1ere ligne vide de la plage I100:I2000.

La référence des lignes vides évolue.


Merci pour votre aide.







1 réponse

Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 149
23 oct. 2015 à 11:43
Bonjour,

On peut faire une macro à paramètres (plage source, plage destination), mais ceci doit marcher :
Sub Macro1()
    Range("A1:E1").Copy
    i = 100
    While Range("L" & i).Value <> "" And i < 2000
        i = i + 1
    Wend
    If i <= 2000 Then
        Range("L" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues
    End If
    
    Range("Q1").Copy
    i = 100
    While Range("I" & i).Value <> "" And i < 2000
        i = i + 1
    Wend
    If i <= 2000 Then
        Range("I" & i).Select
        Selection.PasteSpecial Paste:=xlPasteValues
    End If
End Sub


A+
0
Bonjour


La macro fonctionne très bien merci.

Je souhaiterais ajouter une condition : si AL6=1 alors la macro s'exécute sinon elle ne s'exécute pas.
0
Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 149
23 oct. 2015 à 15:59
Sub Macro1()
    If Range("AL6").Value = 1 Then
        Range("A1:E1").Copy
        i = 100
        While Range("L" & i).Value <> "" And i < 2000
            i = i + 1
        Wend
        If i <= 2000 Then
            Range("L" & i).Select
            Selection.PasteSpecial Paste:=xlPasteValues
        End If
        
        Range("Q1").Copy
        i = 100
        While Range("I" & i).Value <> "" And i < 2000
            i = i + 1
        Wend
        If i <= 2000 Then
            Range("I" & i).Select
            Selection.PasteSpecial Paste:=xlPasteValues
        End If
    End If
End Sub
0
Patrick50 > Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023
23 oct. 2015 à 16:09
Re

OK ça fonctionne


Merci
0