Macro chercher valeurs dans plusieurs onglets
Résolu
pierrot_42
Messages postés
36
Date d'inscription
Statut
Membre
Dernière intervention
-
pierrot_42 Messages postés 36 Date d'inscription Statut Membre Dernière intervention -
pierrot_42 Messages postés 36 Date d'inscription Statut Membre Dernière intervention -
Bonjour cher Forum,
J'utilisai une macro pour aller chercher des valeurs sur une feuille, les concatener et les coller dans une autre.
Je voudrais maintenant que la macro aille chercher ces valeurs dans plusieurs onglets, les concatène et les colle dans un onglet. Mais j'ai un message d'erreur :(
mon fichier :
http://www.cijoint.fr/cjlink.php?file=cj201106/cijDzdA30s.xlsx
screenshot message d'erreur macro
http://www.cijoint.fr/cjlink.php?file=cj201106/cijewzYsKm.png
J'utilise la macro suivante :
Option Explicit
Sub perfect_steering()
Dim I As Integer
Dim J As Long
Dim K As Byte
Dim Lg As Long
Dim Msg As String
Dim ColDep
Dim ColFin
ColDep = Array(5, 35, 47, 50)
ColFin = Array(34, 46, 49, 61)
Lg = 4
If Range("A1") <> "" Then
Lg = Range("A" & Rows.Count).End(xlUp).Row
End If
For aze = 1 To 4
With Sheets(I)
For J = 11 To .Range("A" & .Rows.Count).End(xlUp).Row
For K = 0 To UBound(ColDep)
Msg = ""
For I = ColDep(K) To ColFin(K)
If .Cells(J, I) <> "" And UCase(.Cells(J, I)) <> "OK" And UCase(.Cells(J, I)) <> "KO" Then
Msg = Msg & .Cells(J, I) & ","
End If
Next I
If Len(Msg) > 0 Then
Cells(Lg, 2 + K) = Left(Msg, Len(Msg) - 1)
End If
Next K
Lg = Lg + 1
Next J
End With
Next aze
Columns("B:E").AutoFit
End Sub
Merci d'avance pour votre aide !
Cordialement,
Pierrot
J'utilisai une macro pour aller chercher des valeurs sur une feuille, les concatener et les coller dans une autre.
Je voudrais maintenant que la macro aille chercher ces valeurs dans plusieurs onglets, les concatène et les colle dans un onglet. Mais j'ai un message d'erreur :(
mon fichier :
http://www.cijoint.fr/cjlink.php?file=cj201106/cijDzdA30s.xlsx
screenshot message d'erreur macro
http://www.cijoint.fr/cjlink.php?file=cj201106/cijewzYsKm.png
J'utilise la macro suivante :
Option Explicit
Sub perfect_steering()
Dim I As Integer
Dim J As Long
Dim K As Byte
Dim Lg As Long
Dim Msg As String
Dim ColDep
Dim ColFin
ColDep = Array(5, 35, 47, 50)
ColFin = Array(34, 46, 49, 61)
Lg = 4
If Range("A1") <> "" Then
Lg = Range("A" & Rows.Count).End(xlUp).Row
End If
For aze = 1 To 4
With Sheets(I)
For J = 11 To .Range("A" & .Rows.Count).End(xlUp).Row
For K = 0 To UBound(ColDep)
Msg = ""
For I = ColDep(K) To ColFin(K)
If .Cells(J, I) <> "" And UCase(.Cells(J, I)) <> "OK" And UCase(.Cells(J, I)) <> "KO" Then
Msg = Msg & .Cells(J, I) & ","
End If
Next I
If Len(Msg) > 0 Then
Cells(Lg, 2 + K) = Left(Msg, Len(Msg) - 1)
End If
Next K
Lg = Lg + 1
Next J
End With
Next aze
Columns("B:E").AutoFit
End Sub
Merci d'avance pour votre aide !
Cordialement,
Pierrot
A voir également:
- Macro chercher valeurs dans plusieurs onglets
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Restaurer les onglets chrome - Guide
- Jitbit macro recorder - Télécharger - Confidentialité
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Ouvrir plusieurs onglets en même temps - Guide
2 réponses
Le code ci-dessus est différent de celui du message d'erreur !
Le message dit bien ce qu'il faut dire :
La variable I est déjà utilisée ! (dans la boucle For I=1 to 4)
Et ci-dessus, la variable aze (qui remplace le premier I) n'est pas déclarée, il manque Dim aze as Integer
Le message dit bien ce qu'il faut dire :
La variable I est déjà utilisée ! (dans la boucle For I=1 to 4)
Et ci-dessus, la variable aze (qui remplace le premier I) n'est pas déclarée, il manque Dim aze as Integer
Patrice33740
Messages postés
8561
Date d'inscription
Statut
Membre
Dernière intervention
1 780
PS : remplacer aussi Sheets(I) par Sheets(aze) ou mieux par Worksheets(aze)
Essaie ce code :
Option Explicit
Sub perfect_steering()
Dim aze As Integer
Dim I As Integer
Dim J As Long
Dim K As Byte
Dim Lg As Long
Dim Msg As String
Dim ColDep
Dim ColFin
ColDep = Array(7, 37, 49, 52)
ColFin = Array(36, 48, 51, 63)
For aze = 1 To 4
Lg = 4
If Range("B" & Lg) <> "" Then
Lg = Range("B" & Rows.Count).End(xlUp).Row
End If
With Worksheets(aze)
For J = 14 To .Range("A" & .Rows.Count).End(xlUp).Row
For K = 0 To UBound(ColDep)
Msg = ""
For I = ColDep(K) To ColFin(K)
If .Cells(J, I) <> "" And UCase(.Cells(J, I)) <> "OK" And UCase(.Cells(J, I)) <> "KO" Then
Msg = Msg & .Cells(J, I) & ","
End If
Next I
If Len(Msg) > 0 Then
Cells(Lg, 2 + K) = Left(Msg, Len(Msg) - 1)
End If
Next K
Lg = Lg + 1
Next J
End With
Next aze
Columns("B:E").AutoFit
End Sub
Je pars en Week End, je n'ai pas le temps de simplifier tout ça.
Option Explicit
Sub perfect_steering()
Dim aze As Integer
Dim I As Integer
Dim J As Long
Dim K As Byte
Dim Lg As Long
Dim Msg As String
Dim ColDep
Dim ColFin
ColDep = Array(7, 37, 49, 52)
ColFin = Array(36, 48, 51, 63)
For aze = 1 To 4
Lg = 4
If Range("B" & Lg) <> "" Then
Lg = Range("B" & Rows.Count).End(xlUp).Row
End If
With Worksheets(aze)
For J = 14 To .Range("A" & .Rows.Count).End(xlUp).Row
For K = 0 To UBound(ColDep)
Msg = ""
For I = ColDep(K) To ColFin(K)
If .Cells(J, I) <> "" And UCase(.Cells(J, I)) <> "OK" And UCase(.Cells(J, I)) <> "KO" Then
Msg = Msg & .Cells(J, I) & ","
End If
Next I
If Len(Msg) > 0 Then
Cells(Lg, 2 + K) = Left(Msg, Len(Msg) - 1)
End If
Next K
Lg = Lg + 1
Next J
End With
Next aze
Columns("B:E").AutoFit
End Sub
Je pars en Week End, je n'ai pas le temps de simplifier tout ça.