XL 2016 Copie automatique de cellules à un endroit précis

[THEREDCHNICO]

Bonjour à tous

Tous les jours, je récupère des données via une application professionnelle qui se transposent "en jaune" en D3:S3

Je souhaiterais pouvoir copier les chiffres E3:S3 automatiquement et coller leurs valeurs dans la ligne correspondant.

À savoir identifier en A7:A34 la cellule égale à A3 et copier les valeurs dans la 4ème cellule à droite de celle trouvée.

Je pense avoir été clair.

Merci pour votre aide et bon week-end

 

[job75]

Bonsoir THEREDCHNICO,

Enregistrez le fichier en .xlsm et affectez cette macro au bouton :

Sub Copie()
Dim c As Range
Set c = Columns("D").Find([D3], [D3], xlFormulas, xlWhole)
If Not c Is Nothing Then c.Resize(, 16) = [D3:S3].Value 'copie les valeurs
End Sub

A+

 

[job75]

Si l'on veut rechercher dans la colonne A ce n'est guère plus compliqué :

Sub Copie()
Dim c As Range
Set c = Columns("A").Find([A3], [A3], xlValues, xlWhole)
If Not c Is Nothing Then c(1, 5).Resize(, 15) = [E3:S3].Value 'copie les valeurs
End Sub

 

[THEREDCHNICO]

Bonsoir Job 75

Merci beaucoup, c'est exactement ce que je cherchais.
J'ai mis un peu de temps à comprendre le temps d'adapter le code dans le fichier original mais c'est OK.
Encore merci et bon week-end

 

[THEREDCHNICO]

Désolé je n'avais pas vu la 2nde solution.
Si j'ai bien compris :
1: on cherche D3 dans la colonne, on trouve en D17
On se positionne en D17
On copie les cellules (D3:S3) et on colle les valeurs des 16 cellules (D3 + 15 cellules suivantes)

2: on cherche A3 dans la colonne, on trouve en A17
On déplace le curseur de A17 en E17 et on copie les cellules (E3:S3)
On copie les cellules (D3:S3) et on colle les valeurs des 15 cellules (E3 + 14 cellules suivantes)

Encore merci
@+

 

[Cousinhub]

Hi,
@THEREDCHNICO
Pense également à clore le fil en doublon que tu as créé sur l'autre forum.... (pour info, pas très bien vu, le cross-postage....)
Bon W-E

 

[THEREDCHNICO]

Bonjour à tous

Merci pour votre aide et bon Week-end.

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @THEREDCHNICO
Un peu tard comme d'hab, et avec des fioritures non demandées mais qui pourraient servir ...

J'ai transformé ton tableau de données en Tableau Structuré avec une colonne vide nommée "ColVide" (police de l'entête blanche)
J'ai remplacé la fonction NO.SEMAINE (à la sauce USA) par NO.SEMAINE.ISO (à la sauce européenne disponible depuis la version 2013)
J'ai ajouté une table sur 3 années pour les jours fériés.
J'ai baptisé (nom défini) la date de ton import (cellule D3) "NouvelleDate"

Si tu dois poursuivre sur le même tableau tes imports au mois de décembre, la macro rajoutera automatiquement les lignes (si tu ne les à pas ajouté manuellement)
Si tu dois faire une nouvelle feuille au changement de mois, fais une copie de la feuille et renomme la à ton goût.

Si on est sur un tableau vierge (hors formules des 1ères col) la macro écrit sur la première ligne
Si la nouvelle date est antérieure à la plus petite date du TS et que le tableau n'est pas vide, dans ce cas, la macro insère une ligne en haut
Si la nouvelle date existe déjà dans le tableau elle copie les données à cet endroit
Si la nouvelle date est supérieure à la plus petite date du TS mais n'existe pas dans le TS, elle insère une ligne à la bonne place dans l'ordre chronologique.

le code de la macro :

Sub Copie_Import()
   
     Dim LO As ListObject, Data As Range, RgImport As Range, Wsh As Worksheet
     Dim Ncol As Integer, Nbcol As Integer, Nlgn As Long, idx As Long, Source As String
     Source = ""
   
     'Facultatif :
     'Pour s'assurer que l'on lance la macro à partir d'une feuille qui contient la forme "Btn Copier" (le nom du bouton COPIE)
     On Error Resume Next: Source = Application.Caller: On Error GoTo 0
     If IsError(Source) Then Exit Sub
     If Source <> "Btn Copier" Then Exit Sub
   
   
     Set Wsh = ActiveSheet                   'La feuille contenant le tableau
     'Sortir s'il ny a pas de Tableau Structuré sur la feuille active
     If Wsh.ListObjects.Count = 0 Then Exit Sub
   
     Set LO = Wsh.ListObjects(1)             'Le Tableau Structuré contenant les données
     Set Data = Evaluate(LO.Name)            'La plage de données contenue dans le T.S.
     NoColDate = LO.ListColumns("Date").Index     'L'index de la colonne "Date"
     Nbcol = LO.ListColumns.Count - NoColDate + 1 'Le nombre de colonnes à partir de la colonne "Date"
   
     'Recherche de la date à importer dans la colonne "Date" du T.S.
     Nlgn = 0
     On Error Resume Next: Nlgn = WorksheetFunction.Match([NouvelleDate], Data.Columns(NoColDate)): On Error GoTo 0
   
     Select Case True
          Case Nlgn = 0
               If LO.ListRows.Count > 1 Or Data.Columns(NoColDate) <> "" Then
                    'Date à importer inférieure à la date mini : on ajoute une ligne en tête du T.S.
                    LO.ListRows.Add 1, True
               Else
                    'Première saisie, pas d'insertion
               End If
               idx = 1
          Case Data.Rows(Nlgn).Columns(NoColDate).Value = [NouvelleDate].Value
               'Date à importer égale à une date du tableau : on va copier sur cette ligne
               idx = Nlgn
          Case Else
               'Date à importer à insérer soit en fin de tableau, soit après la ligne trouvée :
               'On ajoute une ligne après la ligne trouvée
               idx = Nlgn + 1
               LO.ListRows.Add idx, True
     End Select
   
     Set Data = Evaluate(LO.Name)  '(Si le tableau structuré à été agrandi)
     'Copie des données à importer
     Data.Rows(idx).Columns(NoColDate).Resize(1, Nbcol).Value = [NouvelleDate].Resize(1, Nbcol).Value
   
End Sub

Certains trouverons peut-être cela superflu, mais je me fais un peu plaisir et j'essaie d'envisager l'évolution des besoins ...

Voir le fichier joint
À bientôt
EDIT : Remplacé le fichier joint par le même fichier enregistrer en version 2007 (pour nettoyer les validations matricielles mises par la version 2024)