Microsoft 365 Copie autre feuille

[AppleDance]

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.

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

 

[Staple1600]

Bonjour le fil, AppleDance

•>AppleDance
Recyclons, recyclons 😉

https://www.excel-downloads.com/thr...s-un-nouveau-classeur.20043042/#post-20311744

Essaies en changeant:
Cells(1).CurrentRegion.Copy
par
[A2].CurrentRegion.Copy

 

[AppleDance]

Malheureusement je sais que CurrentRegion ne marchera pas. En effet, cela copiera également la ligne supérieur (que je ne désire pas copier).

Edit: j'ai essayer avec un .End mais je n'i pas réussi.

 

[Staple1600]

Re

Quand j'écris : "Recyclons, recylons"
il faut comprendre: Adaptons le code VBA

 

[Staple1600]

Re

Un petit indice 😉

Sub Adaptons()
Dim r As Range: Set r = Cells(1).CurrentRegion
Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1, r.Columns.Count)
MsgBox r.Address
End Sub

Je te laisse mixer les codes de mes deux messages 😉

 

[AppleDance]

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 ?

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]

RE

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

 

[Staple1600]

Re

Voici comment je pourrais écrire le code VBA pour faire ce copier/coller

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....🙄

 

[mapomme]

Bonjour @AppleDance 🙂 , @Staple1600 😉

Entre pommes (même si de nationalité différente), ma pomme a une obligation de secours 🙂😀 -
Un danse, c'est plus sympa à deux 😀.
[Pour @Staple1600 : je ne pouvait pas la rater !!! 🙄 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]

RE

Donc tu demandes de l'aide mais tu ne tiens aucun compte des réponses qu'on te donne... 🙄
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 ?

 

[mapomme]

@AppleDance ,

Sois rassuré. Tu n'embêtes personne 🙂

 

[Staple1600]

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]

@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 😉

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

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
😉