VBA - mes cellules ne se copient pas
J'ai fait ce code mais les valeurs que je devrais avoir en cells(a, 5) et cells(a, 6) ne s'affichent pas dans la page souhaitez.
Comment faire ?
Merci
Sub essai()
'
'Trouve le nombre de feuilles dans le fichier
Dim NbFeuil As Long, Sh As Worksheet
NbFeuil = 0
For Each Sh In ActiveWorkbook.Worksheets
NbFeuil = NbFeuil + Sh.HPageBreaks.Count + 1
a = 8
Next Sh
Dim i As Long
For i = 1 To NbFeuil
Sheets(i).Select 'selectionne la feuille de la boucle
If Range("A4").Value = "Dimensions extérieures" Then 'marche seulement pour les longueurs
ActiveSheet.Range("F5").Copy
Sheets("Résumé_panneaux").Select
Cells(a, 4).PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("G5").Copy
Sheets("Résumé_panneaux").Select
Cells(a, 5).PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("H5").Copy
Sheets("Résumé_panneaux").Select
Cells(a, 6).PasteSpecial Paste:=xlPasteValues
a = a + 1
End If
Application.Wait (Now + TimeValue("00:00:01")) 'ca sa sert à rien c'était juste pour tester le passage des feuilles
Next i
End SubUPDATE : J'ai réussi à résoudre le problème, par contre j'ai une erreur d'exécution 9 : l'indice n'appartient pas à la sélection.
Une aide ?
Bonjour
une erreur d'exécution 9 : l'indice n'appartient pas à la sélection.
Le code s'arrête sur quelle ligne ?
Sinon essayez comme ceci
Sub essai()
'Trouve le nombre de feuilles dans le fichier
Dim NbFeuil As Long, Sh As Worksheet
NbFeuil = 0
For Each Sh In ActiveWorkbook.Worksheets
NbFeuil = NbFeuil + Sh.HPageBreaks.Count + 1
Next Sh
Dim i As Long
a = 8
For i = 1 To NbFeuil
If Sheets(i).Range("A4").Value = "Dimensions extérieures" Then 'marche seulement pour les longueurs
With ActiveSheet
.Range("F5:H5").Copy
Sheets("Résumé_panneaux").Cells(a, 4).PasteSpecial Paste:=xlPasteValues
a = a + 1
End With
End If
'Application.Wait (Now + TimeValue("00:00:01")) 'ca sa sert à rien c'était juste pour tester le passage des feuilles
Next i
End SubCordialement
Comment je peux regarder sur quel ligne le problème se situe ?
Je pense qu'il s'agit de la dernière ligne avec Next i car les codes après ne s'exécute pas.
d'ailleurs petite amélioration du code :
Sub Actualiser()
'
'Trouve le nombre de feuilles dans le fichier
Dim NbFeuil As Long, Sh As Worksheet
NbFeuil = 0
For Each Sh In ActiveWorkbook.Worksheets
NbFeuil = NbFeuil + Sh.HPageBreaks.Count + 1
Next Sh
Dim a As Long
a = 8
Dim i As Long
For i = 1 To NbFeuil
Sheets(i).Select 'selectionne la feuille de la boucle
If Range("A4").Value = "Dimensions extérieures" Then 'on fait ca quand on trouve le bon truc sinon dans les autres feuilles on fait rien
Sheets(i).Select
Range("C3").Copy 'Désignation du produit
Sheets("Résumé_Panneaux").Select
Cells(a, 2).PasteSpecial xlPasteValues
Sheets(i).Select
Range("J4").Copy 'Quantité
Sheets("Résumé_Panneaux").Select
Cells(a, 3).PasteSpecial xlPasteValues
Sheets(i).Select
Range("F5").Copy 'Longueur
Sheets("Résumé_Panneaux").Select
Cells(a, 4).PasteSpecial xlPasteValues
Sheets(i).Select
Range("G5").Copy 'Hauteur
Sheets("Résumé_Panneaux").Select
Cells(a, 5).PasteSpecial xlPasteValues
Sheets(i).Select
Range("H5").Copy 'Epaisseur
Sheets("Résumé_Panneaux").Select
Cells(a, 6).PasteSpecial xlPasteValues
Sheets(i).Select
Range("O4").Copy 'Surface unitaire
Sheets("Résumé_Panneaux").Select
Cells(a, 7).PasteSpecial xlPasteValues
Sheets(i).Select
Range("P4").Copy 'Surface TOTAL
Sheets("Résumé_Panneaux").Select
Cells(a, 8).PasteSpecial xlPasteValues
Sheets(i).Select
Range("R4").Copy 'Poids unitaire
Sheets("Résumé_Panneaux").Select
Cells(a, 9).PasteSpecial xlPasteValues
Sheets(i).Select
Range("S4").Copy 'Poids TOTAL
Sheets("Résumé_Panneaux").Select
Cells(a, 10).PasteSpecial xlPasteValues
Sheets(i).Select
Range("C1").Copy 'Nom de l'affaire
Sheets("Résumé_Panneaux").Select
Cells(2, 4).PasteSpecial xlPasteValuesAndNumberFormats
Sheets(i).Select
Range("C2").Copy 'Numéro du dossier
Sheets("Résumé_Panneaux").Select
Cells(3, 4).PasteSpecial xlPasteValuesAndNumberFormats
a = a + 1
End If
Next i
Sheets(Résumé_Panneaux).Select
MsgBox "Actualisation terminée, vous pouvez poursuivre !", vbInformation, "Actualisation"
End Subd'ailleurs petite amélioration du code :
Non justement. Je vous simplifie votre code et vous enlève tous les select (à éviter avec VBA). Vous les remettez...
J'imagine que vous n'avez pas testé ce que je vous ai donné
Edit : cette partie de code pourrait devenir ceci
For i = 1 To NbFeuil
With Sheets(i)
If .Range("A4").Value = "Dimensions extérieures" Then
Sheets("Résumé_Panneaux").Cells(a, 2) = .Range("C3").Value
Sheets("Résumé_Panneaux").Cells(a, 3) = .Range("J4").Value
Sheets("Résumé_Panneaux").Cells(a, 4) = .Range("F5").Value
Sheets("Résumé_Panneaux").Cells(a, 5) = .Range("G5").Value
Sheets("Résumé_Panneaux").Cells(a, 6) = .Range("H5").Value
Sheets("Résumé_Panneaux").Cells(a, 7) = .Range("O4").Value
Sheets("Résumé_Panneaux").Cells(a, 8) = .Range("P4").Value
Sheets("Résumé_Panneaux").Cells(a, 9) = .Range("R4").Value
Sheets("Résumé_Panneaux").Cells(a, 10) = .Range("S4").Value
.Range("C1:C2").Copy
Sheets("Résumé_Panneaux").Cells(2, 4).PasteSpecial xlPasteValuesAndNumberFormats
'.Range("C2").Copy
'Sheets("Résumé_Panneaux").Cells(3, 4).PasteSpecial xlPasteValuesAndNumberFormats
a = a + 1
End If
End With
Next ic'est sur votre code fait vachement plus professionnel
Mais je ne peux pas essayer votre code car je suis en entreprise et les vba sont bloqués lorsqu'ils sont dits étrangers.
J'essayerais depuis chez moi je pense. Merci pour votre aide.
D'ailleurs pourquoi on ne doit pas mettre de select dans le VBA ? Je n'ai vu que ca dès que j'ai commencé...
Bonjour
D'ailleurs pourquoi on ne doit pas mettre de select dans le VBA ?
Les Select et Selection ralentissent le code. Ils ne sont à utiliser que dans de rare cas. Exemple, si vous voulez sélectionner une feuille après une exécution de code.
Sinon VBA fait très bien son travail sans ces instructions.
Plutot que d'utiliser ces instructions, il vous suffit de préciser où doit être effectué le code.
Exemple : Si vous devez ajouter un chiffre 1 en A1 de la feuille Toto, faite ceci
Sheets("TOTO").Range("A1")=1Plutot que ceci
Sheets("TOTO").select
Range("A1")=1Cordialement
oui c'est vrai que ca tombe de sens maintenant que vous le dites.
Merci pour l'astuce