Macro Copie sous condition mensuel

Le 24/06/2018 à 17:35

Bonsoir,

Je m'adresse à vous pour la deuxième fois en peu de temps, et je vous remercie encore de votre aide pour la première fois.

Je souhaite créer une macro qui prenne deux feuilles de mon classeur et qui colle les lignes correspondants au mois -1 du mois actuel dans une 3ème feuille 'analyse' avant de trier le tout.

Malheureusement ma macro ne fonctionne pas et je ne comprends pas du tout pourquoi

ci joint la macro ainsi que le fichier

Merci d'avance

Quentin

Sub analyse()

Dim p As Integer

With Sheets("Suivi groupe salle fourviere")

DerLign = .[A65536].End(xlUp).Row

DerLign = 700

For i = DerLign To 2 Step -1

If .Cells(p, " A ") = mois(aujourdhui - 1) Then Rows(p).Copy

Sheets(" analyse ").Select

Range Rows(p).Select

ActiveSheet.Paste

Next i

End With

With Sheets("Suivi groupe salle victoire")

DerLign = .[A65536].End(xlUp).Row

DerLign = 700

For i = DerLign To 2 Step -1

If .Cells(p, " A ") = mois(aujourdhui - 1) Then Rows(p).Copy

Sheets(" analyse ").Select

Range Rows(700 + p).Select

ActiveSheet.Paste

Next i

End With

Range("A2:E1400").Select

ActiveWorkbook.Worksheets("analyse").Sort.SortFields.clear

ActiveWorkbook.Worksheets("analyse").Sort.SortFields.Add Key:=Range( _

"A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

xlSortNormal

With ActiveWorkbook.Worksheets("analyse").Sort

.SetRange Range("A2:E43")

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

End Sub

14creation-suivi-groupe.xlsm (233.08 Ko)
Le 25/06/2018 à 07:26

Bonjour,

Peut être de cette façon ? (je n'ai pas regardé la partir tri) :

Sub analyse()

    Dim DerLign As Long
    Dim I As Long
    Dim J As Long

    With Worksheets("Suivi groupe salle fourviere")

        DerLign = .Cells(Rows.Count, 1).End(xlUp).Row

        For I = 2 To DerLign

            If Month(.Cells(I, 1).Value) = Month(Date) - 1 Then

                J = J + 1
                .Rows(I).Copy Worksheets("Analyse").Rows(J)

            End If

        Next I

    End With

    With Worksheets("Suivi groupe salle victoire")

        DerLign = .[A65536].End(xlUp).Row

        For I = 2 To DerLign

            If Month(.Cells(I, 1).Value) = Month(Date) - 1 Then

                J = J + 1
                .Rows(I).Copy Worksheets("Analyse").Rows(J)

            End If

        Next I

    End With

End Sub
Le 25/06/2018 à 15:08
Theze a écrit :

Bonjour,

Peut être de cette façon ? (je n'ai pas regardé la partir tri) :

Sub analyse()

    Dim DerLign As Long
    Dim I As Long
    Dim J As Long

    With Worksheets("Suivi groupe salle fourviere")

        DerLign = .Cells(Rows.Count, 1).End(xlUp).Row

        For I = 2 To DerLign

            If Month(.Cells(I, 1).Value) = Month(Date) - 1 Then

                J = J + 1
                .Rows(I).Copy Worksheets("Analyse").Rows(J)

            End If

        Next I

    End With

    With Worksheets("Suivi groupe salle victoire")

        DerLign = .[A65536].End(xlUp).Row

        For I = 2 To DerLign

            If Month(.Cells(I, 1).Value) = Month(Date) - 1 Then

                J = J + 1
                .Rows(I).Copy Worksheets("Analyse").Rows(J)

            End If

        Next I

    End With

End Sub

Merci de votre aide,

Le code me semble en effet correct et le trie se réalise avec une modification de ma part

Le seul dernier soucis est que les seules cases copier sont les 2 premières (Ils ne prends pas les valeurs contenues dans les autres..)

Y a t'il une raison à cela ?

merci d'avance

(Je vous remet la macro dans le module 4 du fichier joints à ce message)

7creation-suivi-groupe.xlsm (247.33 Ko)
Le 25/06/2018 à 18:47

Re,

Une autre piste car il y a des formules qui doivent être construites donc, affectation des valeurs avec construction des formules ce qui est plus rapide que des copier/coller :

Sub analyse()

    Dim Fe_A As Worksheet
    Dim DerLign As Long
    Dim I As Long
    Dim J As Long

    Set Fe_A = Worksheets("Analyse")

    With Worksheets("Suivi groupe salle fourviere")

        DerLign = .Cells(Rows.Count, 1).End(xlUp).Row
        J = 1

        For I = 2 To DerLign

            If Month(.Cells(I, 1).Value) = Month(Date) - 1 Then

                J = J + 1
                Fe_A.Range(Fe_A.Cells(J, 1), Fe_A.Cells(J, 16)).Value = .Range(.Cells(I, 1), .Cells(I, 16)).Value
                Fe_A.Range(Fe_A.Cells(J, 18), Fe_A.Cells(J, 21)).Value = .Range(.Cells(I, 18), .Cells(I, 21)).Value
                Fe_A.Cells(J, 23).Value = .Cells(I, 23).Value

                Fe_A.Cells(J, 17).Formula = "=IFERROR(V" & J & "-O" & J & ","""")" '.Range(.Cells(I, 17), .Cells(I, 21)).Formula
                Fe_A.Cells(J, 22).Formula = "=IFERROR(G" & J & "*H" & J & ","""")"
                Fe_A.Cells(J, 24).Formula = "=IFERROR(G" & J & "*W" & J & ","""")"

            End If

        Next I

    End With

    With Worksheets("Suivi groupe salle victoire")

        DerLign = .[A65536].End(xlUp).Row

        For I = 2 To DerLign

            If Month(.Cells(I, 1).Value) = Month(Date) - 1 Then

                J = J + 1
                Fe_A.Range(Fe_A.Cells(J, 1), Fe_A.Cells(J, 16)).Value = .Range(.Cells(I, 1), .Cells(I, 16)).Value
                Fe_A.Range(Fe_A.Cells(J, 18), Fe_A.Cells(J, 21)).Value = .Range(.Cells(I, 18), .Cells(I, 21)).Value
                Fe_A.Cells(J, 23).Value = .Cells(I, 23).Value

                Fe_A.Cells(J, 17).Formula = "=IFERROR(V" & J & "-O" & J & ","""")" '.Range(.Cells(I, 17), .Cells(I, 21)).Formula
                Fe_A.Cells(J, 22).Formula = "=IFERROR(G" & J & "*H" & J & ","""")"
                Fe_A.Cells(J, 24).Formula = "=IFERROR(G" & J & "*W" & J & ","""")"

            End If

        Next I

    End With

End Sub
Le 27/06/2018 à 14:55
Theze a écrit :

Re,

Une autre piste car il y a des formules qui doivent être construites donc, affectation des valeurs avec construction des formules ce qui est plus rapide que des copier/coller :

Sub analyse()

    Dim Fe_A As Worksheet
    Dim DerLign As Long
    Dim I As Long
    Dim J As Long

    Set Fe_A = Worksheets("Analyse")

    With Worksheets("Suivi groupe salle fourviere")

        DerLign = .Cells(Rows.Count, 1).End(xlUp).Row
        J = 1

        For I = 2 To DerLign

            If Month(.Cells(I, 1).Value) = Month(Date) - 1 Then

                J = J + 1
                Fe_A.Range(Fe_A.Cells(J, 1), Fe_A.Cells(J, 16)).Value = .Range(.Cells(I, 1), .Cells(I, 16)).Value
                Fe_A.Range(Fe_A.Cells(J, 18), Fe_A.Cells(J, 21)).Value = .Range(.Cells(I, 18), .Cells(I, 21)).Value
                Fe_A.Cells(J, 23).Value = .Cells(I, 23).Value

                Fe_A.Cells(J, 17).Formula = "=IFERROR(V" & J & "-O" & J & ","""")" '.Range(.Cells(I, 17), .Cells(I, 21)).Formula
                Fe_A.Cells(J, 22).Formula = "=IFERROR(G" & J & "*H" & J & ","""")"
                Fe_A.Cells(J, 24).Formula = "=IFERROR(G" & J & "*W" & J & ","""")"

            End If

        Next I

    End With

    With Worksheets("Suivi groupe salle victoire")

        DerLign = .[A65536].End(xlUp).Row

        For I = 2 To DerLign

            If Month(.Cells(I, 1).Value) = Month(Date) - 1 Then

                J = J + 1
                Fe_A.Range(Fe_A.Cells(J, 1), Fe_A.Cells(J, 16)).Value = .Range(.Cells(I, 1), .Cells(I, 16)).Value
                Fe_A.Range(Fe_A.Cells(J, 18), Fe_A.Cells(J, 21)).Value = .Range(.Cells(I, 18), .Cells(I, 21)).Value
                Fe_A.Cells(J, 23).Value = .Cells(I, 23).Value

                Fe_A.Cells(J, 17).Formula = "=IFERROR(V" & J & "-O" & J & ","""")" '.Range(.Cells(I, 17), .Cells(I, 21)).Formula
                Fe_A.Cells(J, 22).Formula = "=IFERROR(G" & J & "*H" & J & ","""")"
                Fe_A.Cells(J, 24).Formula = "=IFERROR(G" & J & "*W" & J & ","""")"

            End If

        Next I

    End With

End Sub

Du coup je suis passé par une autre piste, merci de ton aide

Rechercher des sujets similaires à "macro copie condition mensuel"