Filtrer un tableau et figer le deuxième d'un même onglet

[FranQuent]

Bonjour,

Voici un code qui permet de copier un tableau "Table2" pendant qu'on filtre le tableau "Table1".

Option Explicit

Private Sub Worksheet_Calculate()
Dim P As Range, derlig&, n As Byte
Dim i&, P1 As Range, s As Range
Application.ScreenUpdating = False
1 Set P = Range([Table1], [Table2])
derlig = P.Row + P.Rows.Count - 1
n = n + 1
If Me.AutoFilterMode Then n = _
IIf(Intersect(AutoFilter.Range, [Table1]) Is Nothing, 1, 2)
Set P = Range("table" & n)
With Workbooks.Add.Sheets(1) 'nouveau document
'---copie du tableau ligne par ligne---
i = 1
While P.Rows(i).Row <= derlig
If P.Rows(i).EntireRow.Hidden Then .Cells(i, 1) = 1
If i <= P.Rows.Count Then P.Rows(i).Copy .Cells(i, 2)
i = i + 1
Wend
Set P1 = .Range("B1", Intersect(.[B:IV], .UsedRange))
End With
'---insertion de lignes---
2 For i = 1 To P1.Rows.Count
If P1(i, 0) * Application.CountA(P1.Rows(i)) Then
P1.Rows(i).Insert xlDown
If i = 1 Then Set P1 = P1.Parent.Range(P1(0, 1), P1)
GoTo 2
End If
Next
'---nouveau tableau---
Application.EnableEvents = False
P.Clear
P1.Copy P(1, 1)
P(1, 1).Resize(P1.Rows.Count, P1.Columns.Count).Name = "Table" & n
P1.Parent.Parent.Close False 'fermeture du nouveau document
If Not Me.AutoFilterMode And n = 1 Then GoTo 1
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Cependant la copie ne prend pas les formules et met des "#REF!" à la place.
Voyez-vous une solution?

Merci

 

[job75]

Re : Filtrer un tableau et figer le deuxième d'un même onglet

Bonsoir FranQuent,

Franchement sans fichier (et même avec d'ailleurs) vous escomptiez avoir une réponse ???

Heureusement le Père Noël est passé par là :

https://www.excel-downloads.com/thr...-classeur-et-filtrer-une-autre-partie.196556/

A+