XL 2013 Recherche optimisation code

Jacques25

XLDnaute Occasionnel
Bonjour à tous,

Je cherche à optimiser un code assez long qui me fait malgré tout gagné beaucoup de temps.
Dans les grandes lignes :
je rempli un formulaire où il y a une cinquantaine de cellules non contiguës
quand je lance ma macro
elle rempli une base de donnée avec l'ensemble des 50 cellules
elle rempli un autre formulaire avec une partie des 50 cellules
j'enregistre mes 2 formulaires (uniquement les onglets en question) dans 2 fichiers distincts
je les imprimes en PDF

Ma démarche est avant tout d'améliorer la lecture du code que j'essaye de simplifier plus que dans le gain de temps. Si j'arrive à coordonner les 2 ce sera magnifique. Avec ces recherches j'essaye aussi de m'enrichir au niveau de mes maigres connaissances en programmation.
J'ai donc quelques questions pour vous :

J'ai actuellement quelques chose de la sorte :

tata = range ("b7").value
toto = range ("j9").value
titi = range ("p12").value
tutu = range ("w24").value

ligne = sheets("blabla").range("A3").end(xldown).row + 1

cells (ligne,1).value =toto
cells (ligne,2).value = tutu
cells (ligne,3).value = titi
cells(ligne,4).value = tata

Je recopie des formules, des mises en forme

If checbox1.value = true then
with sheets("bloblo")
.range("A4") = titi
.range("B8")= tutu
.range("C15") = tata
end with

J'enregistre mes 2 onglets séparément

range ("b7").value =""
range ("j9").value =""
range ("p12").value =""
range ("w24").value =""

est ce que je suis obligé de passer par with ... end with avec ma condition?
malgré cette condition est ce que je peux regrouper le remplissage de mes 2 onglets en une ligne pour la même donnée ? par exemple
sheets("bloblo").range("A4").value = cells (ligne,3).value =titi

est ce que si je nomme mes 50 cellules donnée1 donnée2 donnée3... je peux faire une boucle et surtout comment l'écrire, j'ai essayer la solution ci-dessous mais ça ne marche pas :
For i = 1 To 50
Sheets("blabla").Cells(ligne, i) = donnée & i.Value
Next i

Merci d'avance pour vos réponses.
Bonne journée à tous.

Jack
 

Jacques25

XLDnaute Occasionnel
Bonjour Mapomme, Oranger,

J'ai voulu vous joindre mon fichier très épuré mais malgré la suppression de 8 onglets et de 5000 lignes dans l'onglet principal il reste toujours trop gros. Si vous avez une idée pour que je le réduise...
J'ai quasiment plus de formule j'ai seulement une vingtaine de cellule colorer (pour la compréhension) j'ai viré pas mal de chose et il reste trop volumineux...

En attendant ton bout de code Mapomme est très interressant je vais déjà pouvoir travailler avec ça.

Merci
@ plus

Jack
 

Jacques25

XLDnaute Occasionnel
Bonjour à tous,

Toujours dans le même style que ma demande initiale et en m'inspirant du code de Mapomme j'essaye en vain de recopier la valeur de cellules éparses dans d'autres cellules éparses. J'ai commencé le code suivant :

Sub derotablo()
Const Données4 = "BL16,AA3,N5,N6,AO6,N8,AT13,U4,U4"
Const Données5 = "D5,M5,D6,D7,D8,J8,E38,K39,M41,E42,M42,A11,E41"
Dim tablo(12)
Dim t, i&, j

t = Split(Données4, ",")

For i = 0 To UBound(t)
tablo(i) = ActiveSheet.Range(t(i))
Next i
tablo(11) = [A10] & " : " & [Z10]
tablo(12) = "rédacteur"

For j = 0 To 12
...

End Sub

Mes données4 sont dans la feuille 1 et je souhaiterai les copiées dans les cellules de la feuille 2 correspondant aux données5 le tout en passant par un tableau parce que certaines valeurs sont fixes (tablo 11 et 12) ou vide (tablo 9 et 10).
Dans le fichier joint en feuille j'ai indiqué à droite de chaque cellule le résultat que je devrais obtenir.
Je bloque une fois que j'ai rempli mon tableau pour le dupliquer sur les cellules de destination.

Merci d'avance pour votre aide.

@ plus

Jack
 

Pièces jointes

  • Essai dupliquer.xlsm
    18.3 KB · Affichages: 27

Jacques25

XLDnaute Occasionnel
Re bonjour,

J'ai trouvé la solution... en tout cas la bonne syntaxe. A croire qu'on réfléchit mieux le ventre plein...
Il y a peut être plus simple mais là mes connaissance sont limitées.
La solution si ça peut aider qq'un :

Private Sub CommandButton1_Click()
Dim temp As Single
temp = Timer
Application.Calculation = xlManual
Const Données4 = "A1,A3,N5,N6,b6,N8,A13,M19,D15"
Const Données5 = "D5,M5,D6,D7,D8,J8,E38,K39,M41,E42,M42,A11,E41"
Dim tablo(12)
Dim t, i&, j

t = Split(Données4, ",")

For i = 0 To UBound(t)
tablo(i) = ActiveSheet.Range(t(i))
Next i
tablo(11) = [A10] & " : " & [Z10]
tablo(12) = "rédacteur"


p = Split(Données5, ",")

For j = 0 To UBound(p)
Sheets("Feuil2").Range(p(j)) = tablo(j)
Next j

MsgBox Timer - temp
Application.Calculation = xlAutomatic
End Sub

Bonne journée à tous;

Jack
 

Discussions similaires

Réponses
28
Affichages
924
Réponses
3
Affichages
550
Réponses
2
Affichages
475

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG