XL 2013 [Résolu] VBA-copier cellules sous condition d'une autre cellule

[CeNedra]

Bonjour à tous,

je vous joins un petit fichier en support de ma demande.

J'ai besoin de déplacer certaines information sous la condition qu'une cellule soit remplie. Si la cellule est vide, les infos ne seront donc pas reportées.

J'ai commencé une macro avec le soutien de différents posts de ce forum. Mais je bloque... Ça me déplace la colonne référente mais je n'arrive pas à trouver le code pour déplacer les autres colonnes.

Je précise que je ne touche pas du tout au langage VBA

Si quelqu'un à une petite idée, ça ne me semble pas irréalisable mais là je bloque.

Je vous remercie

CeNedra

 

[Staple1600]

Bonjour le fil, CeNedra

CeNedra [Bienvenue sur le forum]
Une macro possible

Sub copie_B()
Dim t, lig&, lig2&, f As Worksheet
t = Feuil2.[A1].CurrentRegion
Set f = Feuil3
lig = f.Cells(Rows.Count, 1).End(3).Row
f.Cells(lig + 1, 1).Resize(UBound(t, 1), UBound(t, 2)) = t
lig2 = f.Cells(Rows.Count, 1).End(3).Row
f.Range(Cells(lig + 2, "G"), Cells(lig2, "G")).FormulaR1C1 = "=IF(COUNTA(RC[-6]:RC[-1])=6,""$"",0)"
f.Columns("G:G").SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
f.Columns("G:G").Clear
End Sub

 

[Jacky67]

Bonjour à tous,

je vous joins un petit fichier en support de ma demande.

J'ai besoin de déplacer certaines information sous la condition qu'une cellule soit remplie. Si la cellule est vide, les infos ne seront donc pas reportées.

J'ai commencé une macro avec le soutien de différents posts de ce forum. Mais je bloque... Ça me déplace la colonne référente mais je n'arrive pas à trouver le code pour déplacer les autres colonnes.

Je précise que je ne touche pas du tout au langage VBA

Si quelqu'un à une petite idée, ça ne me semble pas irréalisable mais là je bloque.

Je vous remercie

CeNedra

Bonjour,
Hello JM
Une autre possibilitée
La mise à jour se fait à la sélection de la feuille "Resultat"

Sub copie()
    Application.ScreenUpdating = False
    Sheets("Resultat").Cells.Clear
    With Sheets("Source")
        If .AutoFilterMode Then .ShowAllData
        .UsedRange.AutoFilter Field:=3, Criteria1:="<>"
        .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets("Resultat").[a2]
        .AutoFilterMode = False
    End With
End Sub

 

[Staple1600]

Bonjour Jacky67

CeNedra
Si j'étais moi, je choisirai le code de Jacky67

 

[Staple1600]

Re

Je me permets d'emprunter le code de Jacky67 et de le remanier un chouia à ma sauce

Sub copie2()
Dim f As Worksheet: Set f = Feuil3
Application.ScreenUpdating = False
    With Sheets("Source")
        If .AutoFilterMode Then .ShowAllData
        .UsedRange.AutoFilter Field:=3, Criteria1:="<>"
        .AutoFilter.Range.Offset(1).Copy f.Cells(Rows.Count, 1).End(3)(2)
        .AutoFilterMode = False
    End With
End Sub

 

[CeNedra]

Ouh lala, vous avez été super rapides !

Bon et moi qui trouvais certains codes compréhensibles, vous m'avez perdue ^^

Je vais tester ça sur mon fichier complet et je reviens vers vous

et c'est cool de mettre les codes dans les réponses parce que souvent, j'ai voulu télécharger des fichiers "réponse" et malheureusement la source n'existait plus

 

[CeNedra]

Bon....

Si vos formules fonctionnent toutes très bien, finalement mon fichier est beaucoup plus complexe que ce que je vous avais envoyé. Je pensais que ça suffirait... mais j'avais tort.
Les cellules fusionnées sautent, les données groupées aussi et j'avais oublié de vous préciser que mon fichier contient certaines colonnes que je ne veux pas "déplacer"...

J'ai l'impression de vous avoir fait perdre votre temps :/

Si jamais vous êtes courageux et pas rancuniers je vous laisse un autre fichier, 4 lignes où l'original en contient 120. Vous cassez pas la tête si vous avez autre chose à faire

En tout cas merci vous avez parfaitement répondu à ma demande qui par contre n'était pas assez explicite

 

[Staple1600]

Vous cassez pas la tête si vous avez autre chose à faire

L'autre chose, c'est d'enfiler mon pyjama en pilou, de brosser mes chicots, et d'aller au dodo.

Je laisse les insomniaques courageux prendre le relais

 

[CeNedra]

Bonne idée, je vais faire de même il faut savoir se ménager si on veut rester efficace bonne nuit ^^

 

[Staple1600]

Re

Avant d'aller au dodo, imprime ce mantra sur un papier de qualité, encadre le avec du bois flotté et pose le sur ta table de chevet
Ainsi tu seras armé pour tes prochaines questions

3 – Le titre de la question doit être clair et comporter explicitement le sujet de la demande.
Cela sous-entend qu’une nouvelle demande fait l’objet d’un nouveau fil.

4 – La question doit être posée le plus clairement possible en comprenant bien que le lecteur ne peut pas s’imaginer le problème.

 

[Jacky67]

Bon....

Si jamais vous êtes courageux et pas rancuniers je vous laisse un autre fichier, 4 lignes où l'original en contient 120. Vous cassez pas la tête si vous avez autre chose à faire

En tout cas merci vous avez parfaitement répondu à ma demande qui par contre n'était pas assez explicite

Re..
Profitons-en que JM dort

J'ai supposé que les colonnes "adh" étaient manquantes par erreur, je les ai ajoutées, les feuilles de l'année aussi(sinon modifier array() dans le code)

Sub copie()
    Dim Sh As Worksheet, Derlg&, Col&
    Application.ScreenUpdating = False
    For Each Sh In Sheets(Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre"))
        Sh.Cells.Clear
        If IsNumeric(Application.Match(Sh.Name, Feuil1.[1:1], 0)) Then
            Col = Application.Match(Sh.Name, Feuil1.[1:1], 0)
            With Feuil1
                Derlg = .Cells(.Rows.Count, "A").End(xlUp).Row
                .Range("a3:b" & Derlg).Copy Sh.[a2]
                .Range("g3:g" & Derlg).Copy Sh.[c2]
                .Range(.Cells(2, Col), .Cells(Derlg, Col + 3)).Copy
            End With
            Sh.[d1].PasteSpecial Paste:=xlPasteValues
            Sh.[d1].PasteSpecial Paste:=xlPasteFormats
            Sh.Columns.AutoFit
        End If
    Next
End Sub

 

[CeNedra]

Merci beaucoup !!!!

Adh c'est l'adhésion pour l'année, les adhérents sont censés la payer en septembre ou octobre mais effectivement on prend des adhérents en milieu d'année donc les colonnes seront toujours utiles

J'ai modifié un peu mon fichier original pour le code fonctionne

Merci beaucoup en tout cas, ça va vraiment me faciliter la tache

Bonne soirée