Discussion :

[ISAACSLADE]

Bonjour à tous,

J'ai un fichier avec 4 premiers onglets avec des données et une même entête. Le but est d'extraire les données de ces 4 onglets et des les répartir dans d'autres onglets en s'appuyant sur 2 critères (2 colonnes). J'essaye de faire garder la hauteur de ligne de la source pour toutes les lignes collées mais aussi avoir des colonnes collées ajustées au texte (Je pense à autofit). Pourriez-vous m'aider à faire cela s'il vous plaît ?
J'ai un code avec "PasteSpecial" mais rien ne se passe. Je ne comprends pas.


Sub Macro1()
'
Application.ScreenUpdating = False
Dim sh As Worksheet
Dim filtre
Dim lig As Long
Dim ligA As Long
Dim ligB As Long
Dim ligC As Long
Dim ligD As Long
ligA = Sheets("ISO9001").Range("F" & Rows.Count).End(xlUp).Row
ligB = Sheets("QUALIPSAD").Range("F" & Rows.Count).End(xlUp).Row
ligC = Sheets("QUALIOPI").Range("F" & Rows.Count).End(xlUp).Row
ligD = Sheets("AMELIORATIONS").Range("F" & Rows.Count).End(xlUp).Row
For Each sh In Sheets
On Error Resume Next
If sh.Name <> "ISO9001" And sh.Name <> "QUALIPSAD" And sh.Name <> "QUALIOPI" And sh.Name <> "AMELIORATIONS" And sh.Name <> "Liste" Then
filtre = sh.Name
lig = 12
sh.Cells.ClearContents
If Sheets("ISO9001").FilterMode Then Sheets("ISO9001").ShowAllData
Sheets("ISO9001").Range("A12:O" & ligA).AutoFilter Field:=6, Criteria1:=filtre
Sheets("ISO9001").Range("A12:O" & ligA).AutoFilter Field:=4, Criteria1:="<>POINT FORT (PF)"
Sheets("ISO9001").Range("A12:O" & ligA).SpecialCells(xlCellTypeVisible).Copy
sh.Range("A" & lig).PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sh.Range("A" & lig).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
sh.Range("A" & lig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
If Sheets("ISO9001").FilterMode Then Sheets("ISO9001").ShowAllData
lig = sh.Cells.Find("*", [A1], , , 1, 2).Row + 1
If Sheets("QUALIPSAD").FilterMode Then Sheets("QUALIPSAD").ShowAllData
Sheets("QUALIPSAD").Range("A12:O" & ligB).AutoFilter Field:=6, Criteria1:=filtre
Sheets("QUALIPSAD").Range("A12:O" & ligA).AutoFilter Field:=4, Criteria1:="<>POINT FORT (PF)"
Sheets("QUALIPSAD").Range("A13:O" & ligB).SpecialCells(xlCellTypeVisible).Copy
sh.Range("A" & lig).PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sh.Range("A" & lig).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
sh.Range("A" & lig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
If Sheets("QUALIPSAD").FilterMode Then Sheets("QUALIPSAD").ShowAllData
lig = sh.Cells.Find("*", [A1], , , 1, 2).Row + 1
If Sheets("QUALIOPI").FilterMode Then Sheets("QUALIOPI").ShowAllData
Sheets("QUALIOPI").Range("A12:O" & ligC).AutoFilter Field:=6, Criteria1:=filtre
Sheets("QUALIOPI").Range("A12:O" & ligA).AutoFilter Field:=4, Criteria1:="<>POINT FORT (PF)"
Sheets("QUALIOPI").Range("A13:O" & ligC).SpecialCells(xlCellTypeVisible).Copy
sh.Range("A" & lig).PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sh.Range("A" & lig).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
sh.Range("A" & lig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
If Sheets("QUALIOPI").FilterMode Then Sheets("QUALIOPI").ShowAllData
lig = sh.Cells.Find("*", [A1], , , 1, 2).Row + 1
If Sheets("AMELIORATIONS").FilterMode Then Sheets("AMELIORATIONS").ShowAllData
Sheets("AMELIORATIONS").Range("A12:O" & ligD).AutoFilter Field:=6, Criteria1:=filtre
Sheets("AMELIORATIONS").Range("A12:O" & ligA).AutoFilter Field:=4, Criteria1:="<>POINT FORT (PF)"
Sheets("AMELIORATIONS").Range("A13:O" & ligD).SpecialCells(xlCellTypeVisible).Copy
sh.Range("A" & lig).PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sh.Range("A" & lig).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
sh.Range("A" & lig).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
If Sheets("AMELIORATIONS").FilterMode Then Sheets("AMELIORATIONS").ShowAllData
End If
Next sh
Application.ScreenUpdating = True
End Sub

[deedolith]

Salut,

As-tu pensé à Power Query ?

[ISAACSLADE]

Bonsoir,

Je n'ai aucune connaissance en la matière alors que le VBA oui. J'ai essayé de comprendre comment fonctionnait PowerQuery mais je ne peux pas maitriser du jour au lendemain ce truc. Le VBA, je suis presque à la fi n du développement. Ce n'est pas le moment de repartir à zéro sur un autre truc.

[deedolith]

est-ce que tu peux poster ton classeur avec des données anonymisées ?

Mes premières remarques:
- Application.ScreenUpdating = False n'est à utiliser que lorsque tu auras obtenu le comportement désiré.
"Premature optimization is the root of all evil (or at least most of it) in programming." (Donald Knuth).
- On Error Resume Next est à bannir, ca t'empêche de voir ce qui cloche.
- Ton code mériterais d'être factorisé.

J'ai d'autres remarques, et tu ne vas pas les aimer.

[ISAACSLADE]

Bonsoir,

vous trouverez le fichier anonymisé. Merci en tout cas de prendre le temps de m'aider. J'aimerais arriver à garder la hauteur de ligne donnée des lignes sources des 4 premiers onglets lorsqu'elles sont collées dans leur onglet correspondant (pas d'autofit) et avoir un autofit des colonnes. Le code est déjà présent sur le bas pour l'autofit des colonnes et doit normalement fonctionner.

Merci pour ces remarques. Vous semblez avoir l'expérience en la matière. C'est déjà énorme pour moi.

Merci.

[deedolith]

xlColumnWidths, n'est ce pas plutôt xlPasteColumnWidths ?