Microsoft 365 Copie autre feuille

AppleDance · 25 Mars 2020

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

mapomme · 25 Mars 2020

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.

Staple1600 · 25 Mars 2020

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 · 25 Mars 2020

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 · 25 Mars 2020

Re

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

Staple1600 · 25 Mars 2020

Re

Un petit indice

VB:

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 · 25 Mars 2020

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 · 25 Mars 2020

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 · 25 Mars 2020

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

mapomme · 25 Mars 2020

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 · 25 Mars 2020

Staple1600 à dit:
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 · 25 Mars 2020

@AppleDance ,

Sois rassuré. Tu n'embêtes personne

Staple1600 · 25 Mars 2020

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 · 25 Mars 2020

mapomme à dit:
@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

Microsoft 365 Copie autre feuille

AppleDance

XLDnaute Nouveau

mapomme

Staple1600

XLDnaute Barbatruc

AppleDance

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

AppleDance

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

AppleDance

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires