XL 2010 Résolu par Paf : Tout copier en une seule fois

Usine à gaz · 11 Décembre 2016

Bonjour à toutes et à tous,

Grâce à Laurent (encore Merci au passage), j'ai pu terminer (ou presque) mon code qui est dans le fichier test joint.

Il me reste une dernière étape que je n'arrive pas à codifier malgré essais et recherches.

Vous le verrez (dans le code de ma macro), je copie des infos de la feuille 1 vers la feuille 2.

J'ai 4 séries de plages à copier et j'en suis à copier plage par plage.

J'utilise le code : ActiveSheet.Cells(Rows.Count, "i").End(xlUp)(2).Select pour positionner les copies Feuille2
Pour être certain de tout copier au bons endroits, quelques soient les vides de mes plages et pour raccourcir mon code, j'aimerais faire la copie en une seule fois.

c'est à dire que le code me sélectionne les 4 plages en même temps et copie à partir de la 1ère cellule vide de la colonne "I" de la feuille 2.

J'espère m'être pas trop mal expliqué pour un dimanche matin LOL.
Je vous remercie pour votre aide.
Bon dimanche à toutes et à tous,
Amicalement,
Lionel,

Paf · 11 Décembre 2016

bonjour arthour973,

Je crois comprendre (dans l'exemple) qu'il faut copier de la ligne 11 à la dernière, mais pas sûr pour les colonnes; et les titres de colonnes dans les deux feuilles n'aident pas.

Pouvez vous préciser quelles colonnes au départ vont dans quelles colonnes à l'arrivée ?

A+

Usine à gaz · 11 Décembre 2016

Bonjour Paf,

Merci de m'avoir répondu.
Voici les explications :
feuille 1 > feuille 2
E > I
G/H > J/K
J > L
S/T > M/N

Précision :
Dans l'exemple, "ça tombe" à partir de la ligne 11 mais cela est aléatoire en fonction du contenue de la feuille.

J'ai fait une version 2 de la macro mais cela va alourdir mon fichier qui est déjà très lourd.
Je remets le fichier avec ce complément d'infos.
Amicalement,
Lionel,

Paf · 11 Décembre 2016

Re,

la sub modifiée, à tester :

VB:

Sub NettoieFeuil1()
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Feuil2").Select
ActiveSheet.Unprotect Password:=""
Sheets("Feuil1").Select
ActiveSheet.Unprotect Password:=""
Dim derlg As Long, i As Long, deb As Long
With Sheets("Feuil1") 'à remplacer par nom de ta feuille
derlg = .Range("r" & .Rows.Count).End(xlUp).Row 'remplacer A par colonne concernée
For i = derlg To 1 Step -1
    If .Range("r" & i) = "bleu" Then Exit For
Next i

'***** partie modifiée
deb = i + 1
'** copier
.Range("E" & deb & ":E" & derlg & ",G" & deb & ":H" & derlg & ",J" & deb & ":J" & derlg & ",S" & deb & ":T" & derlg).Copy
End With
'** coller
With Sheets("Feuil2")
    .Range("I" & .Range("I" & .Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    .Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    .EnableSelection = xlNoRestrictions
End With

'****** Fin modif
With Sheets("Feuil1")
   .Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
   .EnableSelection = xlNoRestrictions
End With
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

A+

Usine à gaz · 11 Décembre 2016

Re- Paf,

Merci pour ce code que je suis bien incapable d'écrire.
le comprendre, c'est dans mes cordes maintenant mais l'écrire m'est toujours impossible.
Encore merci.
Amicalement,
Lionel,

XL 2010 Résolu par Paf : Tout copier en une seule fois

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Paf

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Paf

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires