Macro pour copier des colonnes entre deux dates

[fredb27]

Bonjour,

Je cherche une marco pour copier des colonnes et lignes de la feuille export vers la feuille preselection entre deux dates. Je crois qu'on dit une macro avec multicritères ?
Je mets un fichier excel pour illustrer mon cas.

Je souhaite renseigner une date de début et une date de fin dans l'onglet preselection qui viendra filtrer la colonne P de la feuille export (dates des comités) pour copier les données de certaines les colonnes en jaune de la feuille export vers preselection avec un bouton.

Je sais faire des macros simple mais là je suis en difficulté.

Merci par avance pour votre aide. J'espère que c'est possible et que quelqu'un aura la gentilesse de m'aider.

Fred

 

[job75]

Bonjour fredb27,

Voyez le fichier joint et le code de la feuille "Preselection" :

Private Sub Worksheet_Activate()
Dim deb, fin, col, ub%, tablo, resu(), i&, n&, j%
deb = [B2] 'à adapter
fin = [C2] 'à adapter
col = Array(1, 2, 3, 5, 7, 8, 15, 16) 'n° des colonnes à adapter
ub = UBound(col)
If Not IsDate(deb) Or Not IsDate(fin) Then GoTo 1
If fin < deb Then GoTo 1
tablo = Sheets("Export").[A1].CurrentRegion.Resize(, 16) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 0 To ub)
For i = 2 To UBound(tablo)
    If tablo(i, 16) >= deb And tablo(i, 16) <= fin Then
        n = n + 1
        For j = 0 To ub
            resu(n, j) = tablo(i, col(j))
        Next j
    End If
Next i
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A6] 'à adapter
    If n Then
        With .Resize(n, ub + 1)
            .Value = resu
            .Sort .Columns(ub + 1) 'tri sur les dates
            .Borders.Weight = xlThin
        End With
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ub + 1).Delete xlUp 'RAZ dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B2:C2]) Is Nothing Then Worksheet_Activate 'lance la mcro
End Sub

 

[fredb27]

Génial merci! Je n'ai plus qu'à reprendre la logique pour l'adapter à un fichier plus conséquent.

Merci Merci . Si j'ai d'autres questions je reviens vers toi!

Génial

 

[fredb27]

Bonjour fredb27,

Voyez le fichier joint et le code de la feuille "Preselection" :

Private Sub Worksheet_Activate()
Dim deb, fin, col, ub%, tablo, resu(), i&, n&, j%
deb = [B2] 'à adapter
fin = [C2] 'à adapter
col = Array(1, 2, 3, 5, 7, 8, 15, 16) 'n° des colonnes à adapter
ub = UBound(col)
If Not IsDate(deb) Or Not IsDate(fin) Then GoTo 1
If fin < deb Then GoTo 1
tablo = Sheets("Export").[A1].CurrentRegion.Resize(, 16) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 0 To ub)
For i = 2 To UBound(tablo)
    If tablo(i, 16) >= deb And tablo(i, 16) <= fin Then
        n = n + 1
        For j = 0 To ub
            resu(n, j) = tablo(i, col(j))
        Next j
    End If
Next i
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A6] 'à adapter
    If n Then
        With .Resize(n, ub + 1)
            .Value = resu
            .Sort .Columns(ub + 1) 'tri sur les dates
            .Borders.Weight = xlThin
        End With
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ub + 1).Delete xlUp 'RAZ dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B2:C2]) Is Nothing Then Worksheet_Activate 'lance la mcro
End Sub

slt,

j'ai essayé avec un fichier plus conséquent que je mets en pj. Le fichier comporte plus de 85 colonnes.
la date passe de la colonne 16 à 81. J'ai fait la modification dans le code mais ça ne fonctionne pas.
Par ailleurs, c'est en lecture seule! st-il possible d'avoir un bouton au lieu que ça soit activé dans la feuille directement?

Merci par avance pour ta réponse et pour le temps consacré à mon problème.


Fred

 

[fredb27]

slt,

j'ai essayé avec un fichier plus conséquent que je mets en pj. Le fichier comporte plus de 85 colonnes.
la date passe de la colonne 16 à 81. J'ai fait la modification dans le code mais ça ne fonctionne pas.
Par ailleurs, c'est en lecture seule! st-il possible d'avoir un bouton au lieu que ça soit activé dans la feuille directement?

Merci par avance pour ta réponse et pour le temps consacré à mon problème.


Fred

 

[job75]

Prenez le temps de faire les choses proprement : il n'y a aucune valeur ni date à exporter...

 

[fredb27]

Prenez le temps de faire les choses proprement : il n'y a aucune valeur ni date à exporter...

ok désolé voici le fichier avec des données. J'ai le bug est sur ' resu(n, j) = tablo(i, col(j))"

Merci pour votre patience et votre aide

 

[job75]

Les tableaux col et tablo n'étaient pas définis correctement, fichier (2).