Discussion :

[Thomas2412]

Bonjour à tous,

Voilà je suis un peu bloqué dans mon petit programme car je ne sais pas comment formuler en VBA le fait de ne récupérer les valeurs que sur certaines colonnes pour les coller dans un onglet récap. En fait j'ai 17 onglets, dont 16 ont la même structure. Le 17e étant l'onglet récap.
Je souhaite récupérer les valeurs des colonnes 1, 3, 4, 5, 6 et 7 (à partir de la deuxième ligne) de tous mes onglets et les coller dans mon onglet récap et toujours à la même position, soit les colonnes 1, 3, 4, 5, 6 et 7 (à partir de la deuxième ligne) . Avec un tri possible par la colonne 7 qui est une date.
La raison pour laquelle je ne veux pas copier toutes les colonnes de mes onglets c'est que j'inscris des données à posteriori dans mon onglet recap. Et avec le code actuel, elles sont effacées.

Un grand grand merci pour vos pistes.

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Public Sub recap()
Dim WsRecap As Worksheet, Ws As Worksheet
Dim Dlo As Long, Dli As Long
ActiveSheet.Unprotect ("17cpe2015")
  Application.ScreenUpdating = False
  ' je concatène tous mes onglets en ne prenant que les valeurs, pas les formules.
 
  Set WsRecap = Sheets("recap global")
  'WsRecap.Range("a2:BZ60000").ClearContents
  Dlo = 2
  For Each Ws In Worksheets
    If Ws.Name <> WsRecap.Name Then
      Dli = Ws.Cells(Rows.Count, 1).End(xlUp).Row
      If Dli > 1 Then
        Ws.Rows("2:" & Dli).Copy
        WsRecap.Cells(Dlo, 1).PasteSpecial Paste:=xlPasteValues
        Dlo = Dlo + Dli - 1
      End If
    End If
  Next
  Dlo = Dlo - 1
  ' Et maintenant je supprime les lignes si la colonne F contient un 0
  WsRecap.Range("a1:U" & Dlo).AutoFilter field:=6, Criteria1:=0
  If Application.Subtotal(103, Columns(6)) > 1 Then
    WsRecap.Range("F2:F" & Dlo).SpecialCells(xlCellTypeVisible).EntireRow.Delete
  End If
  WsRecap.Range("a1:U" & Dlo).AutoFilter field:=6
  Range("B2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[12]<>"""",""CLOTURE"",IF(RC[10]<>"""",""SIGNATURE DG EN COURS"",IF(RC[9]<>"""",""ORIGINAL DU CONTRAT RECU"", IF(RC[8]<>"""",""VALIDE PAR LE SIEGE"", IF(RC[5]<>"""",""TRANSMIS AU SIEGE"","""")))))"
  Selection.AutoFill Destination:=Range("B2:B386"), Type:=xlFillDefault
    Range("B2:B386").Select
 Range("B3").Select
 ActiveSheet.Protect ("17cpe2015")
 Dim nbre As Byte, cptr As Byte
 
Application.ScreenUpdating = False
nbre = ThisWorkbook.Sheets.Count
cptr = 2
For cptr = 2 To nbre
  Sheets(cptr).Visible = xlSheetVeryHidden
Next
Application.ScreenUpdating = True
End Sub

[Daniel.C]

Bonjour,

Mets ton code entre les balises de code (les "#") sinon, c'est illisible. Modifie-le comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
For Each Ws In Worksheets
    With Ws
        If .Name <> WsRecap.Name Then
            Dli = .Cells(.Rows.Count, 1).End(xlUp).Row
            If Dli > 1 Then
                .Range(.Cells(2, 1), .Cells(Dli, 1)).Copy
                WsRecap.Cells(Dlo, 1).PasteSpecial Paste:=xlPasteValues
                .Range(.Cells(2, 3), .Cells(Dli, 7)).Copy
                WsRecap.Cells(Dlo, 3).PasteSpecial Paste:=xlPasteValues
                Dlo = Dlo + Dli - 1
            End If
        End If
    End With
Next

[Thomas2412]

Merci Daniel.
Bonne journée