amelioration de code

  • Initiateur de la discussion Initiateur de la discussion teamtat
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

teamtat

XLDnaute Occasionnel
Bonjour,
je voudrais savoir si c'ete possible d'ameliorer mon code car la ce n'est que une petite partie, j'ai 300 ligne comme sa.
Je pense que ce soit possible avec une boucle for (je vois comment faire en C mais pas en VBA 🙁 ) . Si quelqu'un a une idée
Merci

Code:
Sub export()

Dim Chemin As String, Fichier As String
Dim wk As Workbook
Dim feuil1 As Variant, shtpda As Variant

'*******Variable à définir**************
Chemin = "\\Angfs1\data\TKAF\R01\A427\_Commun-Agence\GENERAL\Dossier Camille\pda\"
Fichier = "pda.xls"
'***************************************
Application.ScreenUpdating = False


Set wk = Workbooks.Open(Chemin & Fichier)
Set shtbase = ThisWorkbook.Worksheets("base travaux")
Set shtpda = wk.Worksheets("pda")

shtbase.Range("C11,D11,E11,F11,G11,H11,N11,S11").Copy
shtpda.Range("A1").PasteSpecial


If shtbase.CheckBox8.Value = True Then
shtbase.Range("C12,D12,E12,F12,G12,H12,N12,S12").Copy
shtpda.Range("A2").PasteSpecial
End If

If shtbase.CheckBox9.Value = True Then
shtbase.Range("C13,D13,E13,F13,G13,H13,N13,S13").Copy
shtpda.Range("A3").PasteSpecial
End If

If shtbase.CheckBox10.Value = True Then
shtbase.Range("C14,D14,E14,F14,G14,H14,N14,S14").Copy
shtpda.Range("A4").PasteSpecial
End If

If shtbase.CheckBox11.Value = True Then
shtbase.Range("C15,D15,E15,F15,G15,H15,N15,S15").Copy
shtpda.Range("A5").PasteSpecial
End If


If shtbase.CheckBox12.Value = True Then
shtbase.Range("C16,D16,E16,F16,G16,H16,N16,S16").Copy
shtpda.Range("A6").PasteSpecial
End If

end sub
 
Re : amelioration de code

quelque chose comme ca?

for x=2 to 300
If shtbase.CheckBox8.Value = True Then
shtbase.Range("C"&x+10,"D"&x+10,"E"&x+10,"F"&x+10,"G"&x+10,"H"&x+10,"I"&x+10,"J"&x+10").Copy
shtpda.Range("A"&x).PasteSpecial
End If
next


Pour le checkbox je vois pas comment tu peux faire
 
Re : amelioration de code

Sub export()

Dim Chemin As String, Fichier As String
Dim wk As Workbook
Dim feuil1 As Variant, shtpda As Variant
Dim i

'*******Variable à définir**************
Chemin = "\\Angfs1\data\TKAF\R01\A427\_Commun-Agence\GENERAL\Dossier Camille\pda\"
Fichier = "pda.xls"
'***************************************
Application.ScreenUpdating = False

Set wk = Workbooks.Open(Chemin & Fichier)
Set shtbase = ThisWorkbook.Worksheets("base travaux")
Set shtpda = wk.Worksheets("pda")

shtbase.Range("C11,D11,E11,F11,G11,H11,N11,S11").Copy
shtpda.Range("A1").PasteSpecial

For i = 12 To 16
If shtbase.Controls("CheckBox" & i - 4).Value = True Then
Sheets("Feuil1").Range("C" & i & ":" & "H" & i & ",N" & i & ",S" & i).Copy
Sheets("Feuil1").Range("A" & i - 10).PasteSpecial
Next i

End Sub


Essaie çà.
 
Re : amelioration de code

Bonjour à tous,

un essai :

remplace

Code:
If shtbase.CheckBox8.Value = True Then
shtbase.Range("C12,D12,E12,F12,G12,H12,N12,S12").Copy
shtpda.Range("A2").PasteSpecial
End If

If shtbase.CheckBox9.Value = True Then
shtbase.Range("C13,D13,E13,F13,G13,H13,N13,S13").Copy
shtpda.Range("A3").PasteSpecial
End If

If shtbase.CheckBox10.Value = True Then
shtbase.Range("C14,D14,E14,F14,G14,H14,N14,S14").Copy
shtpda.Range("A4").PasteSpecial
End If

If shtbase.CheckBox11.Value = True Then
shtbase.Range("C15,D15,E15,F15,G15,H15,N15,S15").Copy
shtpda.Range("A5").PasteSpecial
End If


If shtbase.CheckBox12.Value = True Then
shtbase.Range("C16,D16,E16,F16,G16,H16,N16,S16").Copy
shtpda.Range("A6").PasteSpecial
End If

par

Code:
For i = 8 to 12
if shtbase.OLEobjects("CheckBox" & i).object.value then shtbase.Range("C" & i+4 & ":H" & i+4 & ",N" & i+4 & ",S" & i+4).Copy shtpda.Range("A" & i-6)
next i
 
Re : amelioration de code

pour le code de martin 2440
Cela fonctionne presque, j'ai une erreur sur cette ligne
Code:
If shtbase.Controls("CheckBox" & i - 4).Value = True Then
erreur d'execution '438' propriété ou méthode non géré par cette objet
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
Réponses
3
Affichages
665
Réponses
2
Affichages
511
Retour