Macro pour copier des colonnes entre deux dates

job75 à dit:

Bonjour fredb27,

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

VB:

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

Cliquez pour agrandir...

job75 à dit:

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

Cliquez pour agrandir...