Copier dans la dernière cellule quittée une cellule d'une autre feuille

ergastule

XLDnaute Nouveau
Bonjour à tous

Je voudrais savoir s'il est possible avec une macro, de copier le contenu d'une cellule dans la dernière cellule quittée d'une autre feuille du même fichier.

Merci d'avance

Cordialement
 

Pièces jointes

  • MATETUDE.xlsm
    174.3 KB · Affichages: 110

ROGER2327

XLDnaute Barbatruc
Re : Copier dans la dernière cellule quittée une cellule d'une autre feuille

Bonjour ergastule.


À l'ouverture de votre fichier, je reçois ce message :

Capture2.jpg

Je ne suis pas allé plus loin.​



ROGER2327
#6743


Vendredi 6 Phalle 140 (Penis Angelicus - Vacuation)
29 Thermidor An CCXXI, 3,9947h - coton
2013-W33-5T09:35:14Z
 

Pièces jointes

  • Capture2.jpg
    Capture2.jpg
    12.3 KB · Affichages: 87
  • Capture2.jpg
    Capture2.jpg
    12.3 KB · Affichages: 87

kastor

XLDnaute Junior
Re : Copier dans la dernière cellule quittée une cellule d'une autre feuille

salut,

tu peux essayer ça.

avant de changer de feuille tu détermines la dernière cellule sélectionnée avec

x = ActiveSheet.Name
y = Selection.Address

'pour vérif avant ==> MsgBox ("feuille (" & x & ") cellule (" & y & " )")


pour y revenir

Sheets(x).Select
Range(y).Select
 

ergastule

XLDnaute Nouveau
Re : Copier dans la dernière cellule quittée une cellule d'une autre feuille

Merci de ta réponse
La 1ère partie fonctionne

Le retour à la feuille initiale ne fonctionne pas, il bloque sur la feuille

Sub Macro5()
'
' Macro5 Macro
'

'
Range("A4").Select
Selection.Copy
Sheets(x).Select
Range(y).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : Copier dans la dernière cellule quittée une cellule d'une autre feuille

Bonsoir à tous.


Pour récupérer le nom de l'onglet et l'adresse de la cellule active dans cet onglet lors du passage à un autre onglet :

  1. Dans un module standard :
    VB:
    Public feuille$
    Public cellule$
  2. Dans le module principal (ThisWorkbook par défaut):
    VB:
    Private Sub Workbook_SheetDeactivate(ByVal Fl As Object)
    Dim af As Worksheet
        Set af = ActiveSheet
        With Application: .EnableEvents = 0: .ScreenUpdating = 0: End With
        Fl.Activate
        feuille = ActiveSheet.Name
        cellule = ActiveCell.Address
        af.Activate
        With Application: .ScreenUpdating = 0: .EnableEvents = 1: End With
    End Sub
On accède ensuite à cette cellule par :
Code:
Sheets(feuille).Range(cellule)
Le code de la procédure Macro5 pourrait alors s'écrire :
VB:
Sub Macro5()
    If feuille = "" Then Exit Sub
    With Application
        .ScreenUpdating = 0
        Range("A4").Copy
        Sheets(feuille).Range(cellule).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .CutCopyMode = False
        .ScreenUpdating = 1
    End With
End Sub
À adapter à la situation réelle...
(Le classeur fourni avec le message #1 est illisible chez moi.)



ROGER2327
#6744


Vendredi 6 Phalle 140 (Penis Angelicus - Vacuation)
29 Thermidor An CCXXI, 8,0474h - coton
2013-W33-5T19:18:50Z
 

ROGER2327

XLDnaute Barbatruc
Re : Copier dans la dernière cellule quittée une cellule d'une autre feuille

Suite...


Un exemple de mise en œuvre dans le classeur joint.​


ROGER2327
#6748


Samedi 7 Phalle 140 (Patrobas, pompier - fête Suprême Quarte)
30 Thermidor An CCXXI, 3,7490h - moulin
2013-W33-6T08:59:51Z
 

Pièces jointes

  • XLD_209681_Collage spécial.xlsm
    26.2 KB · Affichages: 59

job75

XLDnaute Barbatruc
Re : Copier dans la dernière cellule quittée une cellule d'une autre feuille

Bonjour ergastule, salut Roger, kastor,

Enregistrez le fichier en .xlsm ou .xls et collez dans ThisWorkbook :

Code:
Private Sub Workbook_Open()
If ActiveSheet.Type = xlWorksheet Then ActiveCell.Name = "memcel"
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Type <> xlWorksheet Then Exit Sub
If TypeName([memcel]) = "Range" Then Sh.[A4].Copy [memcel]
ActiveCell.Name = "memcel"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ActiveCell.Name = "memcel"
End Sub
Il peut y avoir des feuille autres que des feuilles de calcul dans le classeur (Graphique).

C'est la cellule A4 de chaque feuille qui est copiée, adaptez si nécessaire.

A+
 

ROGER2327

XLDnaute Barbatruc
Re : Copier dans la dernière cellule quittée une cellule d'une autre feuille

Bonjour à tous, bonjour job75

(...)
Il peut y avoir des feuille autres que des feuilles de calcul dans le classeur (Graphique).
(...)
Oui ! Et je n'en ai pas tenu compte.
Réparons cet oubli...​


ROGER2327
#6749


Samedi 7 Phalle 140 (Patrobas, pompier - fête Suprême Quarte)
30 Thermidor An CCXXI, 6,2384h - moulin
2013-W33-6T14:58:20Z
 

Pièces jointes

  • XLD_209681_Collage spécial_2.xlsm
    31.2 KB · Affichages: 36

job75

XLDnaute Barbatruc
Re : Copier dans la dernière cellule quittée une cellule d'une autre feuille

Bonjour à tous,

Au lieu de mémoriser la cellule dans un nom défini on peut la mémoriser dans une variable.

Mais c'est plus précaire.

Placez tout ce code dans Thisworkbook :

Code:
Dim memcel 'mémorise la variable

Private Sub Workbook_Open()
If ActiveSheet.Type = xlWorksheet Then Set memcel = ActiveCell
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Type <> xlWorksheet Then Exit Sub
If Not memcel Is Nothing Then Sh.[A4].Copy memcel
Set memcel = ActiveCell
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Set memcel = ActiveCell
End Sub

Sub TestVariable()
If TypeName(memcel) = "Range" Then
  MsgBox "La cellule 'memcel' existe..."
  Application.OnTime Now, "ThisWorkbook.TestVariable"
  End 'réinitialise tout
Else
  MsgBox "La cellule 'memcel' n'existe plus..."
End If
End Sub
Fermez et rouvrez le fichier puis lancez la macro TestVariable

On constate que l'instruction End a "détruit" memcel.

A+
 

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 489
Messages
2 088 855
Membres
103 976
dernier inscrit
kaizertv2001@gmailcom