Copie de cellule selon condition

Bonjour les amis,

Je souhaite recopier les cellules selon condition. le plus explicite est de regarder l'image et de voir le fichier

Merci beaucoup

J'ai l'impression que c'est complexe. Je vais essayer de trouver autrement...

Merci quand même

Bonjour

Pour pouvoir t'aider il faudrait connaitre les conditions.

sinon il te suffit de glisser vers le bas.

Je souhaite copier le nom qui figure sur la Colonne A vers le bas tant qu'il y a un nom dans la colonne B et ainsi de suite. Dans l'exemple, nous avons un nom en cellule A2 qui s'insère automatiquement, je souhaite maintenant dire à excel, que tant qu'il y a un nom en B3 alors la cellule C3 = NOM qui est en A2 ainsi de suite. Et lorsque le nom change comme dans l'exemple en A9 alors Copier le nouveau nom qui est en A9 vers le bas tant qu'il y a des noms en B10, B11.

J'espère que ce assez clair dans l'explication

Je viens de trouver la demie-solution en mode formule : SI(A2="";"";SI(A2<>"";A2;""))

Etant donnée que les noms initiales situés en A2 et en A9 sont gérés par VBA, je ne pense pas que ça va être facile de gérer ce problème.

C'est exactement ce que j'allais te proposer.

Le mieux c'est de reprendre le code VBA depuis le début et d'ajouter la fameuse colonne des noms de groupe. Sa réglera tout le problème en VBA.

Merci quand même

Bonjour,

J'ai essayé ma formule et malheureusement elle ne prend pas en compte tous les paramètres liés à l'automatisation de mes tableaux.

Est-ce que quelqu'un pourrais m'aider en mode vba, je pense que sa sera plus sûr ?

Bonjour,

En E2, tu peux mettre :

=RECHERCHE("zzz";A$2:A2)

tirer vers le bas et tu auras le résultat voulu pour cette mention de groupe...

Mais il me semble qut l'idée, c'est de l'avoir en colonne A : si cette mention est mise par macro (absente de ton fichier), il faut la modifier pour qu'elle produise le résultat voulu !

Cordialement.

Voilà le fichier complet MFerrand.

Sincerement j'aurai préféré un traitement en macro, je trouve que c'est mieux. Qu'en penses-tu ?

Tu as dit que les noms figurant en col. A étaient gérés par VBA... Il convient que tu fournisses le code utilisé !

Cordialement.

Oups, j'avais pas compris, autant pour moi :

voilà le code :

Sub ExtraireParGroupeColonneB()
Dim O As Long, NbLg As Long
Dim n As Integer
Dim H1 As Worksheet
Dim Mondico As Object
Dim Tablo
Dim Interdits
Dim ligne

Call RegrouperLesBD

  Interdits = Array("&", ":", "/", "\", "~?", "~*", "[", "]", Chr(34))

  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.DisplayAlerts = True

  Call SupprimeFeuille

  Set H1 = Sheets("BD")
  If H1.FilterMode = True Then H1.ShowAllData
  NbLg = H1.Range("A" & Rows.Count).End(xlUp).Row

rep = InputBox("Choisir la lettre de la colonne pour la création de fiches", "CREATION DE FICHES PAR GROUPES", "B")

  H1.Columns(rep).Copy H1.Columns("O")

  With H1.Range("O2:O" & NbLg)
    For n = 0 To UBound(Interdits)
      .Replace what:=Interdits(n), replacement:="_", lookat:=xlPart
    Next n

  End With

  Set Mondico = CreateObject("Scripting.dictionary")
  For O = 2 To NbLg
    Mondico(H1.Range("O" & O).Value) = ""
  Next O

  H1.Range("O1:P1") = "XYZ"

  Tablo = Mondico.keys
  For n = 0 To UBound(Tablo)
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = Tablo(n)
    Sheets("Modèle").UsedRange.Copy
    Sheets(Tablo(n)).Range("A1").PasteSpecial

    With Sheets(Tablo(n))
      .Range("A2") = Tablo(n)
      H1.Range("P2") = Tablo(n)

        For Each cel In H1.Range("G2:G" & NbLg) 'pour chaque cellule de G2 à G_DernièreLigne
            r = cel.Row
            noms = H1.Range("C" & r)
            If H1.Range(rep & r) = Tablo(n) Then
                c = .Range("A1000").End(xlUp).Row + 1
                If .Range("A9") = "" Then
                    H1.Range("C" & r & ":H" & r).Copy 'Copie de C à H feuille BD
                    .Range("A" & c).PasteSpecial xlPasteValues 'Colle depuis A feuille modèle
                End If

                If Not .Range("E9:E" & c).Find(cel) Is Nothing And Not .Range("A9:A" & c).Find(noms) Is Nothing Then
                'Si le numero de pièce existe déjà dans la feuille modèle alors...
                Set ligne = .Range("E9:E" & c).Find(cel) 'on trouve la ligne correspondante
                    If Not ligne Is Nothing And .Range("A" & ligne.Row) <> noms Then
                        Flig = ligne.Row
                        Do
                            cel.Value = cel
                            Set ligne = .Range("E9:E" & c).FindNext(.Range("E" & Flig))
                            ligne = ligne.Row
                        Loop While ligne = Flig And .Range("A" & ligne) <> noms
                    Else
                    ligne = ligne.Row
                    End If
remp:
                    'On prend chaque cas de compte et on vient mettre le débit et crédit dans les colonnes correspondantes
                    If H1.Range("A" & r) = "VACANCES - COLOS" Then .Range("G" & ligne) = .Range("G" & ligne) + H1.Range("I" & r): .Range("H" & ligne) = .Range("H" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "ALIMENTATION A L'EXTERIEUR." Then .Range("I" & ligne) = .Range("I" & ligne) + H1.Range("I" & r): .Range("J" & ligne) = .Range("J" & ligne) + H1.Range("J" & r)
                    If H1.Range("A" & r) = "AUTRES REMB.FRAIS GR 1" Then .Range("N" & ligne) = .Range("N" & ligne) + H1.Range("J" & r): .Range("M" & ligne) = .Range("M" & ligne) + H1.Range("I" & r)
                Else
                    H1.Range("C" & r & ":H" & r).Copy
                    .Range("A" & c).PasteSpecial xlPasteValues
                    ligne = c
                    GoTo remp
                End If

            End If

        Next cel

           ActiveWindow.DisplayOutline = False

    End With

      'ICI AJUSTER LIGNES ET COLONNES
    Call MiseEnPageFeuilleModeleColonnesEtLignes

  Next n

  H1.Columns("O:P").Clear
  H1.Select
    Call consolidation

End Sub

Désolé je me suis trompé de code, voilà le bon qui traite les noms, c'est dans la consolidation :

Sub consolidation()

Dim NomGrp As String
Dim Ws As Worksheet
Dim TDB As Worksheet

Set TDB = Sheets("TABLEAU DE BORD COLONIES")
TDB.Range("A5:Q" & Rows.Count).ClearContents

    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Range("A1").Value Like "FICHE RECAPITULATIVE*" Then
            NomGrp = Ws.Name
            DLgrp = Ws.Range("A8").End(xlDown).Row
            DLtdb = TDB.Range("B" & Rows.Count).End(xlUp).Row + 1

            Ws.Range("A9:P" & DLgrp).Copy
            TDB.Range("B" & DLtdb).PasteSpecial
            TDB.Range("A" & DLtdb).Value = NomGrp
            Range("A5").Copy
            Range("A" & DLtdb).PasteSpecial Paste:=xlPasteFormats
        End If
    Next Ws

Application.CutCopyMode = False

Call MasquerLigneVidePourTableauDeBord

'Call PourCalculDuTotalEnfantBeneficiantDesColoniesTriesSansDoublon

'Call PourCalculDuTotalDePrestatairesTriesSansDoublon

'Call CopierNbEnfantBeneficiantColonieEnCelluleB102

'Call CopierNbPrestatairesEnCelluleG102

End Sub

Le code fourni fait visiblement partie d'un autre fichier, et l'on ne voit rien dans le code cité qui produise le fichier concerné par la question... ?

Je suis d'accord avec toi pour le premier code mais le second est bien celui qui permet de mettre les noms de groupes.

Y a t'il une possibilité de le faire en mode formule et condition, =si.... ?

En prenant bien en compte que s'il y a une ligne vide entière, ne rien mettre.

Réfléchissons, tu fournis un fichier : Copie de cellule....xlsx. Le nom importe peu mais il ne contient pas de macro, et tout laisse penser qu'il est produit à partir d'un autre fichier, lequel contient du code permettant de générer le fichier soumis à l'examen...

Si l'on suppose juste, il y a diverses commandes susceptibles de produire un nouveau fichier, je n'en ai vu cependant (sauf erreur de ma part) aucune dans le code cité !

On ne sait donc pas vraiment ce qu'il en est ! En outre, on pourra éventuellement se passer de la source si on dispose du code composant le nouveau classeur, et si ce code rapproché du contenu du classeur cible obtenu est suffisant (peut être correctement interprété) pour y apporter la petite modification voulue pour modifier les données de la colonne A dans le sens souhaité...

Bonjour à tous,

Tout simplement

Option Explicit
Sub test()
Dim rng As Areas, r As Range
    On Error Resume Next
    With Sheets("feuil1")
        With .Range("A5:A" & .Range("B" & .Rows.Count).End(xlUp).Row)
            Set rng = .SpecialCells(4).Areas
        End With
    End With
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub
    For Each r In rng
        r.Value = r(0).Value
    Next
    Set rng = Nothing
End Sub

klin89

Bonjour Miloud,

Tu n'as toujours pas répondu à mon dernier MP !

as-tu réussi ? ou le sujet ne t'intéresse plus ?

dhany

Merci beaucoup Klin89

ça fonctionne parfaitement et c'est ce que je voulais avoir comme résultat.

Merci encore

Bonjour Dhany,

Je viens de te répondre en MP