Microsoft 365 Copie autre feuille

AppleDance

XLDnaute Nouveau
Bonjour à tous.

J'ai récemment fait un macro copiant des données et les collants dans une autre feuille.
J'ai réussi à le faire.
mais je recherche une autre méthode qui ne m'obligerait pas de copier/coller une entière plage sélectionner mais uniquement les cellule contenant une donnée à partir de A2.

Voici la macro que j'ai. Comment l'améliorerez vous ?

En vous remerciant.

VB:
Dim copySheet As Worksheet, pasteSheet As Worksheet

Set copySheet = Worksheets("Feuil1")
Set pasteSheet = Worksheets("Feuil2")

copySheet.Range("A2:Y1000").Copy Destination:=Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    Sheets("Feuil2").Range("A2:Y50000").Borders(xlEdgeBottom).LineStyle _
    = xlContinuous
    Sheets("Feuil2").Range("A2:Y50000").Borders(xlEdgeBottom).Weight _
    = xlThin
    
    Application.CutCopyMode = False

Range("A2:Y1000").Delete

If IsEmpty(Range("A2:Y1000")) = True Then
    Exit Sub
End If

End Sub
 
Solution
Bonjour @AppleDance :) , @Staple1600 ;)

Entre pommes (même si de nationalité différente), ma pomme a une obligation de secours :):D -
Un danse, c'est plus sympa à deux :D.
[Pour @Staple1600 : je ne pouvait pas la rater !!! :rolleyes: il fallait bien trouver une raison, donc]

Attention! CurrentRegion s'arrête à la première ligne ou colonne vide). Une méthode "basique" pour pallier cet écueil. Voir fichier.

AppleDance

XLDnaute Nouveau
Je pense avoir réussi grâce à cette méthode.
Ce n'est pas du tout pareil que la solution proposié, mais j'ai l'impression que ça marche.
Vous en pensez quoi ?

VB:
Private Sub CommandButton12_Click()

Dim copySheet As Worksheet, pasteSheet As Worksheet

Set copySheet = Worksheets("Feuil1")
Set pasteSheet = Worksheets("Feuil2")

copySheet.Range("A2:Y" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Destination:=Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

   Sheets("Feuil2").Range("A2:Y" & Cells(Rows.Count, 1).End(xlUp).Row).Borders(xlEdgeBottom).LineStyle _
    = xlContinuous
    Sheets("Feuil2").Range("A2:Y" & Cells(Rows.Count, 1).End(xlUp).Row).Borders(xlEdgeBottom).Weight _
    = xlThin

Application.CutCopyMode = False

Range("A2:Y1000").Delete

If IsEmpty(Range("A2:Y1000")) = True Then
    Exit Sub
End If

End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Voici comment je pourrais écrire le code VBA pour faire ce copier/coller
VB:
Sub Copy_Ter()
Dim r As Range: Set r = Worksheets("Feuil1").Cells(1).CurrentRegion
Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1, r.Columns.Count)
r.Copy
With Worksheets("Feuil2").Cells(Rows.Count, 1).End(3)(2)
    .PasteSpecial Paste:=xlPasteAllExceptBorders
    .CurrentRegion.Borders.Weight = 2
End With
Application.CutCopyMode = False
r.Clear
End Sub
Je te laisse tester ou pas....:rolleyes:
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @AppleDance :) , @Staple1600 ;)

Entre pommes (même si de nationalité différente), ma pomme a une obligation de secours :):D -
Un danse, c'est plus sympa à deux :D.
[Pour @Staple1600 : je ne pouvait pas la rater !!! :rolleyes: il fallait bien trouver une raison, donc]

Attention! CurrentRegion s'arrête à la première ligne ou colonne vide). Une méthode "basique" pour pallier cet écueil. Voir fichier.
 

Pièces jointes

  • AppleDance- copier juste ce qu'il faut- v1.xlsm
    27.6 KB · Affichages: 9
Dernière édition:

AppleDance

XLDnaute Nouveau
RE

Donc tu demandes de l'aide mais tu ne tiens aucun compte des réponses qu'on te donne... :rolleyes:
As-tu essayé au moins le code dans le message#5?

Désolé, c'est juste que j'essayais de trouver une solution de mon côté également et j'avais trouver celle-ci entre temps.

J'ai bien tester la macro posté mais je n'arrivais pas à la modifier comme je voulais "en mixant", ne comprenant pas toute la macro.

@Staple1600 je m'excuse pour le temps perdu.

@mapomme : merci pour l'aide et la macro.

Je vais essayer de comprendre comment fonctionne vos macros pour ne plus avoir a vous embêter sur ça.

PS: sur la deuxième macro poster par @Staple1600, il y a une erreur sur la ligne 2 (Set r) mais lorsque je prends la remplace par la ligne posté au #5, tout marche. Pourtant la ligne me semble identique, non ?
 

Staple1600

XLDnaute Barbatruc
Re, mapomme

•>AppleDance
Du temps confiné, c'est pas perdu in fine ;)
Personne n'embête personne sur le forum ;)
(A part peut-être (non, pas Mme Tatcher;)), mapomme et ma pomme qui se taquinent parfois au débotté)
Mais toujours dans la bonne humeur.

PS: Le code du message#8 a été testé sur un classeur avec deux feuilles Feuil1 et Feuil2.
Sur Feuil1: des données en A1:YN et Feuil2 vide.
Pas d'erreur lors du test.
 

Staple1600

XLDnaute Barbatruc
@AppleDance ,

Sois rassuré. Tu n'embêtes personne :)
Moi, je m'embête, et je suis tout confiné de partout
Alors pour faire plaisir à la pomme qui danse ;)
Enrichi (BBcode):
Sub Copy_Test_II(Optional ²_With_NO_CurrentRegion_En_Feuil1_²)
Dim rng As Range: Set rng = Worksheets("Feuil1").UsedRange
Intersect(rng, rng.Offset(1)).Copy
With Worksheets("Feuil2").Cells(Rows.Count, 1).End(3)(2)
    .PasteSpecial Paste:=7: .CurrentRegion.Borders.Weight = 2
End With
Application.CutCopyMode = False
rng.Clear
End Sub
Si le désœuvrement vous prend aux alentours de minuit, ci dessous, un bout de code pour avoir de quoi tester la macro Copy_Test_II
VB:
Sub DATAS_Pour_Test()
Dim f_r_m$, rng As Range
f_r_m = "=ROW()*COLUMN()&CHAR(INDEX({83;116;97;112;108;101},RANDBETWEEN(1,6)))&ADDRESS(ROW(),COLUMN(),4)&REPT(CHAR(RANDBETWEEN(48,57)),3)"
Sheets("Feuil1").Cells.Clear
Sheets("Feuil1").[A1:Y1] = "=""ITEM_1""&COLUMN()"
Randomize
Sheets("Feuil1").Cells(2, 1).Resize(Application.RandBetween(4, 10), 25).Formula = f_r_m
With Sheets("Feuil1").Cells(1).CurrentRegion
.Value = .Value: .Columns.AutoFit: .Borders.Weight = 2
End With
End Sub
NB: Tout ceci à tester sur un classeur vierge avec deux feuilles: Feuil1 et Feuil2
;)
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 069
Messages
2 085 037
Membres
102 762
dernier inscrit
Ucef