Macro de transfert de données d'un tableau à l'autre

Bonsoir à toutes et tous

avant de venir demander votre aide, j'ai déjà cherché sur net un sujet identique à le mien qui peut m'aider à résoudre mon problème, néanmoins toutes les macro trouvées sont différentes à celle que je cherche.

En effet, par la présente je viens demander votre aide pour une macro avec laquelle je vais transférer mensuellement des données (valeurs) d'un tableau à l'autre.

Les 2 tableaux se trouvent sur le même classeur.

Ci-joint un fichier exemple avec tous détails.

Merci d'avance

bonsoir,

A tester :

Sub galopin()
Dim a, i%, iM%, iH%, iG%, WsM As Worksheet, WsG As Worksheet
Set WsM = Worksheets("TRM")
Set WsG = Worksheets("TRG")
iM = WsM.Range("C" & WsG.Rows.Count).End(xlUp).Row
iH = iM - 9
iG = WsG.Range("C" & WsG.Rows.Count).End(xlUp).Row + 1
WsG.Range(WsG.Cells(iG, 2), WsG.Cells(iG + iH, 2)) = WsM.Range("S5")
WsG.Range(WsG.Cells(iG, 2), WsG.Cells(iG + iH, 2)).NumberFormat = "mmm yy"
a = WsM.Range("C9:S" & iM).Value
WsG.Range(WsG.Cells(iG, 3), WsG.Cells(iG + iH, 19)) = a
End Sub

A+

Bonjour,

Une autre proposition à étudier.

Cdlt.

Option Explicit

Private Sub cmdArchiver_Click()
Dim wb As Workbook
Dim wsData As Worksheet, wsTable As Worksheet
Dim lo As ListObject
Dim rngData As Range, rCell As Range
Dim I As Long

    Application.ScreenUpdating = False
    '---------------------------------------------------------------------
    Set wb = ActiveWorkbook
    Set wsTable = wb.Worksheets("TRG")
    Set lo = wsTable.ListObjects(1)
    '---------------------------------------------------------------------
    With lo
        If .InsertRowRange Is Nothing Then
            Set rCell = .HeaderRowRange.Cells(2). _
                        Offset(.ListRows.Count + 1)
        Else
            Set rCell = .InsertRowRange.Cells(2)
        End If
        I = .ListRows.Count
    End With
    '---------------------------------------------------------------------
    Set rngData = Me.Cells(7, "C").CurrentRegion
    rngData.Offset(2, 0). _
            Resize(rngData.Rows.Count - 2, rngData.Columns.Count).Copy
    rCell.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    '---------------------------------------------------------------------
    rCell.Offset(, -1). _
            Resize(lo.ListRows.Count - I).Value = Me.Cells(5, "S")
    '---------------------------------------------------------------------
    Set rCell = Nothing: Set rngData = Nothing
    Set lo = Nothing
    Set wsTable = Nothing
    Set wb = Nothing

End Sub

Bonjour galopin, Jean-Eric, le forum

Les 2 codes sont bien fonctionnels, utiles et impeccables.

Merci beaucoup pour votre appréciable aide.

Je vous souhaite bonne continuation et très bonne journée

Cordialement.