[RESOLU] Transfert de données d'une feuille à l'autre

[Scheerami]

Bonjour le Forum et merci pour le temps que vous me consacrez.

Ma demande :

Je souhaiterai que lorsque :

en colonne "F" de l'onglet 2015, le menu déroulant libère : " Remise à l'année suivante " le contenu des colonnes C- D - E, apparaissent dans les colonnes C- D - E de l'onglet de l'année suivante, en l'occurrence 2016.

Je joins un fichier en exemple

D'avance MERCI Scherra

 

[Paf]

Re : Transfert de données d'une feuille à l'autre

Bonjour,

le code existant en Private Sub Worksheet_Change(ByVal Target As Range) de la feuille 2015 fonctionnerait ...si les deux premières lignes ne comportaient des cellules fusionnées, qui faussent le calcul de la ligne où inscrire les données.

Une solution consiste à 'défusionner' la cellule D1, déplacer le titre en D2; c'est moins joli , mais ça marche mieux.

A+

 

[job75]

Re : Transfert de données d'une feuille à l'autre

Bonsoir Scheerami, Paf,

Où avez-vous été pêcher Paf cette histoire de cellules fusionnées 😕

Mettre dans ThisWorkbook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim n&, r As Range, w As Worksheet, sup As Range
n = Val(Right(Sh.Name, 4))
If n Then
  Set r = Intersect(Target, Sh.Range("F3:F" & Sh.Rows.Count), Sh.UsedRange)
  If Not r Is Nothing Then
    Application.EnableEvents = False 'désactive les événements
    On Error Resume Next
    Set w = Sheets(CStr(n + 1)) 'année suivante
    For Each r In r 'en cas d'entrées multiples
      If r = "Remise à l'année suivante" Then
        With w.Cells.Find("*", , xlValues, , xlByRows, xlPrevious)(2)
          r.EntireRow.Copy .EntireRow 'copie des lignes
          .EntireRow.Cells(1, "F") = ""
        End With
        Set sup = Union(r, IIf(sup Is Nothing, r, sup))
      End If
    Next
    If Not sup Is Nothing Then sup.EntireRow.Delete 'suppression des lignes
    Application.EnableEvents = True 'réactive les événements
  End If
End If
End Sub

Fichier joint.

Bonne fin de soirée et A+

 

[job75]

Re : Transfert de données d'une feuille à l'autre

Re,

La macro précédente supprime aussi les lignes quand on est sur la dernière année (2016).

Il vaut mieux alors seulement effacer "Remise à l'année suivante" :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim n&, r As Range, w As Worksheet, sup As Range
n = Val(Right(Sh.Name, 4))
If n Then
  Set r = Intersect(Target, Sh.Range("F3:F" & Sh.Rows.Count), Sh.UsedRange)
  If Not r Is Nothing Then
    Application.EnableEvents = False 'désactive les événements
    On Error Resume Next
    Set w = Sheets(CStr(n + 1)) 'année suivante
    For Each r In r 'en cas d'entrées multiples
      If r = "Remise à l'année suivante" Then
        With w.Cells.Find("*", , xlValues, , xlByRows, xlPrevious)(2)
          r.EntireRow.Copy .EntireRow 'copie des lignes
          .EntireRow.Cells(1, "F") = ""
        End With
        If w Is Nothing Then r = "" Else _
          Set sup = Union(r, IIf(sup Is Nothing, r, sup))
      End If
    Next
    If Not sup Is Nothing Then sup.EntireRow.Delete 'suppression des lignes
    Application.EnableEvents = True 'réactive les événements
  End If
End If
End Sub

Fichier (2).

Bonne nuit et A+

 

[Paf]

Re : Transfert de données d'une feuille à l'autre

Bonjour à tous

Où avez-vous été pêcher Paf cette histoire de cellules fusionnées

J'ai omis de préciser (et c'était important !) que les cellules fusionnées en questions se trouvaient en feuille "2016".

D1 et D2 étant fusionnées, DerLig = Wcible.Range("D" & Rows.Count).End(xlUp).Row + 1 ramène 2 (alors qu'il aurait fallut 3), et les écritures
Wcible.Cells(DerLig, 4) = Target.Offset(0, -2).Value
Wcible.Cells(DerLig, 3) = Date

ne s'exécutent pas.

Sans réécrire le code il y avait peut-être d'autres solutions que celle que j'ai proposé. mais elle reste valable.

A+

 

[job75]

Re : Transfert de données d'une feuille à l'autre

Hello Paf,

Oui, je n'avais pas vraiment cherché à comprendre.

Mais il est inutile de défusionner, il suffit de remplacer :

DerLig = Wcible.Range("D" & Rows.Count).End(xlUp).Row + 1

par :

DerLig = Wcible.Range("D" & Rows.Count).End(xlUp).Offset(1).Row

A+

 

[Scheerami]

Re : [RESOLU] Transfert de données d'une feuille à l'autre

Bonjour le Forum et Grands MERCIS à vous Job75 et Paf pour le temps que vous m'avez consacré.

Cela fonctionne comme je le souhaitais Encore MERCIS Scheerami