Bonjour !
C'est super, c'est que je voulais
Néanmoins, il me manque la colonne Foil à mettre à coté les doubles avec le style du tableau.
J'ai essayé de comprendre le code mais en vain.
Je te montre le code que j'ai fait, tu me diras où est l'erreur pour que je puisse comprendre un peu le système du macro
Option Explicit
Dim w As Workbook, wb As Workbook, f As Worksheet, fN As Worksheet, fb As Worksheet
Dim fv As Worksheet
Dim tablo, tabloR1(), tabloR2()
Dim i&, k1&, k2&
Sub ExtraireTousLesOnglets()
'Set f = ActiveSheet
'tablo = Range("B3:I" & Range("B" & Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
Set w = ActiveWorkbook
For Each wb In Workbooks
If wb.Name <> ActiveWorkbook.Name Then
For Each fb In wb.Worksheets
If fb.Range("C2") = "Cartes manquantes" Then
wb.Close False
GoTo suite
End If
Next fb
End If
Next wb
suite:
Workbooks.Add
Set wb = ActiveWorkbook
'Set fN = ActiveSheet
For Each f In w.Worksheets
If f.Name <> "Sommaire" Then
tablo = f.Range("B3:I" & f.Range("B" & Rows.Count).End(xlUp).Row)
wb.Sheets.Add before:=wb.Sheets(wb.Worksheets.Count)
ActiveSheet.Name = f.Name
Set fN = ActiveSheet
f.Range("A:C").Copy: fN.Range("A1").PasteSpecial xlPasteFormats
fN.Range("B2,E2") = "N°"
fN.Range("C2") = "Cartes manquantes"
f.Range("A:D").Copy: fN.Range("D1").PasteSpecial xlPasteFormats
fN.Range("F2") = "Cartes en double"
fN.Range("G2") = "Doubles"
fN.Range("H2") = "Foil"
k1 = 0: k2 = 0
For i = 1 To UBound(tablo, 1)
If tablo(i, 3) = 0 Then
ReDim Preserve tabloR1(1 To 2, 1 To k1 + 1)
tabloR1(1, k1 + 1) = tablo(i, 1)
tabloR1(2, k1 + 1) = tablo(i, 2)
k1 = k1 + 1
End If
If tablo(i, 7) > 1 Then
ReDim Preserve tabloR2(1 To 3, 1 To k2 + 1)
tabloR2(1, k2 + 1) = tablo(i, 1)
tabloR2(2, k2 + 1) = tablo(i, 2)
tabloR2(3, k2 + 1) = tablo(i, 7)
k2 = k2 + 1
End If
Next i
On Error Resume Next
fN.Range("B3").Resize(UBound(tabloR1, 2), 2) = Application.Transpose(tabloR1)
fN.Range("E3").Resize(UBound(tabloR2, 2), 3) = Application.Transpose(tabloR2)
Range("A1").Select
End If
Next f
Sheets(1).Activate
Application.CutCopyMode = False
End Sub
Et si possible, ça serai un plus de mettre le nom de l'onglet juste au dessus du tableau pour mieux se repérer
Et je ne t'embête plus, promis !
Cordialement,