Copier/Coller data d'une feuille à l'autre, lignes et colonnes variables

Bonjour,

Dans le fichier joint, j'essaye de copier/coller les données d'un tableau en Feuil2, vers certaines cellules contenues dans une Feuil1.

Je suis parvenu à copier/coller les données en fonction d'une valeur référente que j'ai en colonne D_i de la Feuil1.

Sub Trans_Data()

For i_Feuil1 = 8 To 59

KEY_Feuil1 = ActiveWorkbook.Worksheets(1).Range("D" & i_Feuil1)
Der_Ligne = ThisWorkbook.Worksheets("Feuil2").Range("Tableau1").ListObject.ListColumns(1).DataBodyRange(Range("Tableau1").Rows.Count).End(xlUp).Row
For i_Feuil2 = 2 To Der_Ligne

KEY_IE = ThisWorkbook.Worksheets("Feuil2").Range("D" & i_Feuil2)

If KEY_Feuil1 = KEY_IE Then

ThisWorkbook.Worksheets(1).Range("D" & i_Feuil1) = ThisWorkbook.Worksheets("Feuil2").Range("D" & i_Feuil2)

ThisWorkbook.Worksheets(1).Range("K" & i_Feuil1) = ThisWorkbook.Worksheets("Feuil2").Range("E" & i_Feuil2)

ThisWorkbook.Worksheets(1).Range("L" & i_Feuil1) = ThisWorkbook.Worksheets("Feuil2").Range("F" & i_Feuil2)

ThisWorkbook.Worksheets(1).Range("M" & i_Feuil1) = ThisWorkbook.Worksheets("Feuil2").Range("G" & i_Feuil2)

ThisWorkbook.Worksheets(1).Range("N" & i_Feuil1) = ThisWorkbook.Worksheets("Feuil2").Range("H" & i_Feuil2)

End If
Next
Next

End Sub

A présent, j'essaye de reproduire la même chose, mais en prenant en compte que mes 4 colonnes vont changer en fonction d'une date contenue dans la Feuil 1.

Pour le 01/08/23, mes colonnes sont K, L, M, N

ThisWorkbook.Worksheets(1).Range("K" & i_Feuil1) 

ThisWorkbook.Worksheets(1).Range("L" & i_Feuil1) 

ThisWorkbook.Worksheets(1).Range("M" & i_Feuil1) 

ThisWorkbook.Worksheets(1).Range("N" & i_Feuil1) 

Mais pour le 02/08/23, mes colonnes seront P,Q,R,S ; pour le 03/08 U,V,W,X, etc... pour le 04/08 : X+2 colonnes ,X+3colonnes ,X+4colonnes ,X+5colonnes

Auriez-vous une idée ?

Merci beaucoup !

Bonjour,

Essayez ceci:

Cdlt

Bonjour Arthuro !

Cela fonctionne !

Mais bizarrement, lorsque dans la macro je change la plage Col_f1 = Application.Match(Jour, f1.Range("A3:FE3"), 0) en K3:FE3, il s'arrête toujour à G3.

J'ai alors déplacé la range G3:I3 (=aujourd'hui) vers la ligne du dessus et cela fonctionne parfaitement !

Merci beaucoup !

Re Arthuro !

J'ai adaptée votre macro en fonction d'une autre mise en forme de la feuille 2.

En utilisant de le debugger, tout semble correspondre et pourtant, les données de la feuille 2 ne vont pas vers la feuille 1.

Une idée d'où cela peut venir ?

Merci beaucoup !

JonVa a écrit :

J'ai adaptée votre macro en fonction d'une autre mise en forme de la feuille 2.

En utilisant de le debugger, tout semble correspondre et pourtant, les données de la feuille 2 ne vont pas vers la feuille 1.

Une idée d'où cela peut venir ?

quelques d'erreurs:

- la recherche de la dernière ligne se fait soit en partant de la ligne la plus basse et en remontant, soit en partant de la première et en descendant(ce que vous avez fait) or, avec la dernière méthode la recherche s'arrêtera dès qu'une cellule vide est trouvée et ignorera toutes celles en dessous.

-pour relever le contenu d'une cellule, on peut utiliser Cells ou Range, mais la syntaxe qui suit n'est pas la même,

pour Cells(N° de Lig, N° de Col), Ligne et colonne séparées par une virgule.

pour Range(Lettre de la Colonne et N° de Ligne).value

Attention, il y a aussi une macro évènementielle dans le module de la feuille 1(j'y ai apporté quelques modif)

Macro dans le module standard:

Option Explicit

Sub IMPORTER2_DATA()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim i_f1 As Long, i_f2 As Long
    Dim DerLig_f1 As Long, DerLig_f2 As Long, Col_f1 As Long
    Dim KEY_f1 As String, KEY_f2 As String
    Dim Jour As Double

    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")

    DerLig_f1 = f1.Range("B" & Rows.Count).End(xlUp).Row
    For i_f1 = 8 To DerLig_f1
        KEY_f1 = f1.Range("B" & i_f1)
        If KEY_f1 <> "" Then
            DerLig_f2 = f2.Range("T" & Rows.Count).End(xlUp).Row
            For i_f2 = 5 To DerLig_f2
                Jour = f2.Range("V1")
                KEY_f2 = f2.Range("T" & i_f2)
                If KEY_f1 = KEY_f2 Then
                    'Repérage de la zone destinée à recevoir les données
                    Col_f1 = Application.Match(Jour, f1.Range("A3:FE3"), 0)
                    f1.Cells(i_f1, Col_f1) = f2.Range("H" & i_f2).Value
                    f1.Cells(i_f1, Col_f1 + 1).Value = f2.Range("M" & i_f2).Value
                    f1.Cells(i_f1, Col_f1 + 2).Value = f2.Range("N" & i_f2).Value
                    f1.Cells(i_f1, Col_f1 + 3) = f2.Range("S" & i_f2).Value
                End If
            Next i_f2
        End If
    Next i_f1

    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Macro dans le module de la feuille1:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Sortie
    Application.EnableEvents = flase
    If Not Intersect(Target, Range("H3:I3")) Is Nothing Then
        Columns("EU:FH").EntireColumn.Hidden = False
        Mois = Range("I1").Value
        Annee = Range("J1").Value
        Select Case Mois
            Case Is = "April", "June", "September", "November"
                Columns("FE:FH").EntireColumn.Hidden = True
            Case Is = "February"
                If Annee Mod 4 = 0 Then
                    Columns("EZ:FH").EntireColumn.Hidden = True
                Else
                    Columns("EU:FH").EntireColumn.Hidden = True
                End If
        End Select
    End If
Sortie:
    Application.EnableEvents = True
End Sub

Cdlt

Bonjour Arhturo !

Tout fonction super !

Merci beaucoup !