Copier contenu cellules vers une autre feuille de calcul

Bonjour,

Etant débutant en VBA et très mauvais dans la construction de boucles, je bute sur la construction d'un code permettant de copier certaines données d'une feuil vers une autre.

J'ai un fichier avec 3 tableaux en Feuil1. Je souhaite copier certaines cellules de la Feuil1 dans un tableau base de données se trouvant en Feuil2 selon une condition.

Condition => Lorsque l'on lance la macro elle doit venir interroger Feuil1 la présence de contenu dans la colonne "M" pour l'ensemble des 3 tableaux :

M28:M32 ; M38:M43 ; M50;M53

Dès lors qu'elle va trouver une valeur dans la colonne M, elle va venir copier certaines valeurs de la ligne concernées ( colonne => A;I;J;K;L;M;J21) vers la Feuil2

La macro va continuer cet exercice jusqu'à la fin du 3ème tableau Feuil1.

En PJ, je vous joint le fichier avec des explications complémentaires.

Merci d'avance pour votre aide.

Bonne fin de journéee

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonsoir GMB et merci pour ta réponse.

La macro fonctionne , bien que je soit presque incapable de la cerner pour le moment

Quelques précisons quant à mon besoin :

1) Il manque la donnée attendue en colonne "X8" à savoir la valeur contenue dans la cellule J21 de la Feuil1 (JOUR/NUIT)

2) Les lignes avec X1,X2 etc...ne doivent pas être retranscrites lors de la copie en Feuil2 (il s'agit en réalité du titre des différentes colonnes, elles ne sont pas utiles pour moi)

3) Je souhaite qu'a chaque déclenchement de la macro les données copiées en Feuil1 viennent s'ajouter aux précédentes dans ce tableau au lieu de les supprimer.

La réponse doit surement se trouver avec le .ClearContents qu'il faut je suppose enlever mais quoi y mettre à la place, c'est la bonne question

f2.Range("D14").CurrentRegion.Offset(1, 0).ClearContents

Du coup, lors du prochain déclenchement de la macro les prochaines données doivent donc se copier à partir de la ligne 23, à la suite des données déjà présentes.

J'ai repris les 3 point ci-dessus dans mon fichier en PJ.

Un grand merci pour ton aide

Bonne soirée

Salut Spike,
Salut gmb,

Sub Stats()
'
Dim sWk As Worksheet, iRow%
'
Set sWk = Worksheets("XXX")
Application.ScreenUpdating = False
'
With Worksheets("STATS")
    For x = 28 To 54
        If x Mod 11 > 5 And x Mod 11 < 11 And sWk.Range("M" & x).Value <> "" Then _
            iRow = .Range("D" & Rows.Count).End(xlUp).Row + 1: _
            .Range("D" & iRow).Value = sWk.Range("A" & x).Value: _
            .Range("E" & iRow).Resize(1, 6) = sWk.Range("I" & x).Resize(1, 6).Value: _
            .Range("K" & iRow).Value = sWk.[J21]
    Next
    .Range("D14:K" & iRow).Borders.LineStyle = xlContinuous
    .Range("D13:K" & iRow).BorderAround Weight:=xlMedium
End With
'
Application.ScreenUpdating = True
'
End Sub

A+

Bonjour

Bonjour à tous

Nouvelle version.

Bye !

Bonjour et merci à tous les deux pour vos réponses.

GMB ton fichier fonctionne mais j'ai toujours les X1,X2,X3 etc... qui se reportent dans le tableau en Feuil2 alors qu'il s'agit du titre des colonnes présentes dans les tableaux en Feuil1. Je ne souhaite donc pas qu'ils soient reportés dans le tableau Feuil2.

Curilis57, ton fichier fonctionne parfaitement et répond à mes attentes.

Toutefois, la macro fonctionne si et seulement si les tableaux (FeuilXXX)restent figés. Je ne l'avais pas forcément précisé, mais leurs taille ainsi que l'écart (en nb de lignes) entre chaque tableaux est susceptible d'évoluer.

J'essaye depuis ce matin de comprendre la structure de ta macro pour l'adapter aux éventuelles évolutions mais je m'y casse les dents

Autre sujet, j'ai essayé d'ajouter une autre information dans la colonne L de la Feuil STATS, il s'agit de la date présente en Cellule L21 Feuil(XXX).

.Range("K" & iRow).Value = sWk.[J21]

.Range("L" & iRow).Value = sWk.[L21]

J'ai tout simplement tenter de copier la même structure de code que pour la cellule J21 mais cela ne fonctionne pas.

Si vous avez la solution je suis preneur ainsi que d'éventuels commentaires dans le code afin que je couche moins bête

Encore merci à tous les deux pour votre aide et patience

Bonne journée

Salut Spike,
Salut gmb,

j'avais déjà songé à une autre approche qui aurait réglé cette éventualité mais vu les dernières infos, cela n'aurait guère fonctionné mieux pour une raison très simple :
Qu'y a-t-il dans ces fameuses lignes de séparation entre les tableaux et dont le nombre, qui plus est, varie ?

Là est le seul souci de ta demande : comment la macro peut-elle savoir qu'elle lit la dernière ligne d'un tableau et non une éventuelle donnée de ces lignes de séparation ?

Une bonne réponse de ta part agrémentée d'une autre info cruciale que tu aurais peut-être oubliée dans les détours de ta réflexion et l'affaire est faite !

A+

Nouvelle version.

Bye !

Bonsoir gmb et curulis,

Je rejoins complètement ton analyse Curulis et effectivement sans cette information, difficile de trouver la macro qui correspond.

Ces lignes entre les tableaux seront pour la plupart vides, certaines d'entres elles pourront contenir du texte. La colonne "M" entre chaque tableaux restera vide.

A partir du moment ou la colonne M reste vide entre chaque tableau pas de confusion possible pour la macro.

Dans la colonne M, on ne peut retrouver que des données numériques, pas de texte (info cruciale qu'il aurait été important de préciser dès le départ. MEA CULPA).

Ces données numériques seront obligatoirement une succession de 6 chiffres => Exemple : 223344

Le cheminement du programme que j'imagine et suis bien incapable de rédiger serait le suivant :

For x = 28 To 94

Le périmètre de la macro s'étend de la ligne 28 à 94 (plage bien adaptable selon mes besoins pour le coup)

On interroge ligne par ligne le contenu de la colonne M (des ligne 28 à 94)

Dès lors qu'une cellule de la colonne M contient une valeur numérique et uniquement numérique (avec 6 chiffres successifs) alors lancer la copie des cellules de la ligne concernées (colonne : X1,X2,.....X9) vers la Feuil STATS => Cette partie là fonctionne déjà très bien dans vos programmes respectifs.

Le fichier que je transmet est bien entendu un exemple car mon fichier source contient des données sensibles.

Dans le fichier en PJ, j'ai calqué la structure actuelle de mon fichier source (même nombre de lignes pour les 3 tableaux, mêmes cellules)

Encore désolé pour les précisions surement tardives. Ayant tellement la tête dans le guidon, je pensais les avoir évoquées lors de mon premier message.

Merci d'avance pour votre aide et bonne fin de journée

Salut Spike,
Salut gmb,

quelques modifications plus tard...

Private Sub cmdOK_Click()
'
Dim sWk As Worksheet, iRow%
'
Application.ScreenUpdating = False
'
With Worksheets("STATS")
    For x = 28 To Range("M" & Rows.Count).End(xlUp).Row
        If IsNumeric(Range("M" & x).Value) And Len(Range("M" & x).Value) = 6 Then _
            iRow = .Range("D" & Rows.Count).End(xlUp).Row + 1: _
            .Range("D" & iRow).Value = Range("A" & x).Value: _
            .Range("E" & iRow).Resize(1, 4) = Range("I" & x).Resize(1, 4).Value: _
            .Range("I" & iRow).Resize(1, 2) = Range("M" & x).Resize(1, 2).Value: _
            .Range("K" & iRow).Resize(1, 2).Value = Array([J21], [L21])
    Next
    .Range("D14:L" & iRow).Borders.LineStyle = xlContinuous
    .Range("D13:L" & iRow).BorderAround Weight:=xlMedium
    Me.cmdOK.BackColor = &HC000&
End With
'
Application.ScreenUpdating = True
'
End Sub

Petit changement : tu jettes si tu n'aimes pas et on revient à la version originale !

J'ai remplacé ton bouton par un bouton ActiveX, badgé "STATS"
- il est vert clair lorsque tes tableaux comptent au moins une valeur en [M:M] . Pas de contrôle de validité de cette valeur : j'ose croire que tu n'as pas l'habitude de te saboter ! ;
- rouge clair si aucune valeur en [M:M] n'est comptabilisée ;
- vert foncé après activation de la macro jusqu'au prochain changement en [M:M] impliquant le calcul décrit ci-dessus.

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Intersect(Target, Columns(13)) Is Nothing Then _
    Me.cmdOK.BackColor = IIf(WorksheetFunction.CountA(Range("M28:M" & Range("M" & Rows.Count).End(xlUp).Row)) > 2, &H80FF00, &H8080FF)
'
End Sub

A+

Bonjour Curulis et GMB,

Parfait parfait et encore parfait ! Ton fichier fonctionne parfaitement et répond à l'ensemble de mes besoins.

J'ai enlevé le bouton active X pour repartir sur mon bouton classique. Utilisant déjà dans mon fichier source un bouton pour déclencher d'autres macro.

En tout cas, un grand merci à vous deux pour votre aide et votre patience.

Bonne journée