Bonjour je viens vous demandé votre aide Svp .
j'utilise ce code qui me permet de chercher sur plusieur Feuil de mon classeur et de récupéré si la valeur est supérieure à 0 et de la copié dans ma page accueil certaine colone de cette ligne. cela fonctionne bien pour 4 colonne.
mon probleme c'est que je souhaite faire la meme chose mais avec 19 colonne et la j'ai un peut tous essayer et cela fonctionne plus c'est à dire selon ce que je change dans le code il me dit que cela ne fais pas partie de la sélection ou tous simplement aucune erreur mais rien n'est copié
voici ce code:
et merci pour votre aide précieuse
j'utilise ce code qui me permet de chercher sur plusieur Feuil de mon classeur et de récupéré si la valeur est supérieure à 0 et de la copié dans ma page accueil certaine colone de cette ligne. cela fonctionne bien pour 4 colonne.
mon probleme c'est que je souhaite faire la meme chose mais avec 19 colonne et la j'ai un peut tous essayer et cela fonctionne plus c'est à dire selon ce que je change dans le code il me dit que cela ne fais pas partie de la sélection ou tous simplement aucune erreur mais rien n'est copié
voici ce code:
Code:
Private Sub CommandButton2_Click()
With Sheets("Accueil")
Range("A5:S33").Select
Selection.ClearContents
Range("E26").Select
End With
Dim Ws As Worksheet, Tbl() As Variant, C As Integer
Application.ScreenUpdating = False
ReDim Tbl(1 To 5, 1 To 4)
C = 1
For Each Ws In Worksheets
If Left(Ws.Name, 3) = "BDD" Then
With Ws
For Each CEL In .Range("A4:A" & .Range("R65000").End(xlUp).Row)
If CEL > 0 Then
l = CEL.Row
Tbl(1, C) = .Range("A" & l).Value
Tbl(2, C) = .Range("B" & l).Value
Tbl(3, C) = .Range("C" & l).Value
Tbl(4, C) = .Range("D" & l).Value
Tbl(5, C) = .Range("E" & l).Value
Tbl(6, C) = .Range("F" & l).Value '<== à partir d'ici cela ne fonctionne plus
Tbl(7, C) = .Range("G" & l).Value
Tbl(8, C) = .Range("H" & l).Value
Tbl(9, C) = .Range("I" & l).Value
Tbl(10, C) = .Range("J" & l).Value
Tbl(11, C) = .Range("K" & l).Value
Tbl(12, C) = .Range("L" & l).Value
Tbl(13, C) = .Range("M" & l).Value
Tbl(14, C) = .Range("N" & l).Value
Tbl(15, C) = .Range("O" & l).Value
Tbl(16, C) = .Range("P" & l).Value
Tbl(17, C) = .Range("Q" & l).Value
Tbl(18, C) = .Range("R" & l).Value
Tbl(19, C) = .Range("S" & l).Value
C = C + 1
ReDim Preserve Tbl(1 To 5, 1 To C)
End If
Next CEL
End With
End If
Next Ws
Tbl = Application.Transpose(Tbl)
With Sheets("Accueil")
LI = .Range("A600").End(xlUp).Row + 1
.Cells(LI, 1).Resize(UBound(Tbl, 1), UBound(Tbl, 2)) = Tbl
End With
''deproteg.ProtegeTout
Application.ScreenUpdating = True
End Sub
et merci pour votre aide précieuse