Résultats pour "simplification code vba access"

10'458 résultats pour cette recherche

Bonjour a tous

Voila j'ai un travail à faire mais je ne sais pas trop comment m'y prendre alors je demande votre aide je vous explique

J'ai un groupe de travail installé et des bases de données Access faites sous Access 1997 et je voudrais les transférer pour les mettre sous Access 2003

Il y a des bases qui contiennent du code VBA et d'autres non donc je voudrais savoir comment les transferer ( celles avec code et celle sans code )

Egalement je souhaiterais savoir comment debuguer du code fait sous Access 1997 afin qu'il soit compatible sous Access 2003 et comment m'y prendre pour savoir a quelles lignes sont les bug

Voila c'est tout pour moi si vous avez d'autres questions

Merci

Bonjour,

Je débute en VBA et j'aimerais savoir si il y a moyen de simplifier mon code VBA inclus dans la feuille 1 de mon classeur.

Explications :

J'ai écris ce code pour que dans les cellules déverrouillées de ma feuille, si on écrit en minuscule, ce soit automatiquement transcrit en majuscule. Ca fonctionne .... mais je me demande si il n'y a quand même pas moyen de simplifier ce code ! (vous verrez par vous même).

De plus, mon classeur va comporter 56 feuilles identiques (pour la mise en forme). Je me vois mal appliquer ce code aux 56 pages ! Là aussi , pouvez-vous m'aider à mettre ce code au bon endroit pour qu'il soit appliqué à toutes les feuilles de mon classeur.

Notez que les feuilles sont verrouillées par mdp (mdp : test). Pour le code, ca ne pose pas de problème vu que les cellules dans lesquelles je dois écrire sont bien déverrouillées.

J'espère avoir été assez clair.

7classeur1.xlsm (22.49 Ko)

Bonjour à tous,

Voici mon code :

Private Sub ChkB01_Click()
    'CONCERNÉ/NON-CONCERNÉ 01
    Sheets("Base").Select
Dim CL As Range
Dim Dlig As Integer
Dlig = Cells(Rows.Count, "A").End(xlUp).Row

Set CL = Range("A2:A" & Dlig).Find(What:=Me.TBoxM1.Value, LookIn:=xlValues, LookAt:=xlWhole)
   If ChkB01.Value = True Then
   Sheets("Base").Range("DH" & CL.Row) = "NC"
   Else
   Sheets("Base").Range("DH" & CL.Row).ClearContents
   End If

Set CL = Range("A2:A" & Dlig).Find(What:=Me.TBoxM2.Value, LookIn:=xlValues, LookAt:=xlWhole)
   If ChkB01.Value = True Then
   Sheets("Base").Range("DH" & CL.Row) = "NC"
   Else
   Sheets("Base").Range("DH" & CL.Row).ClearContents
   End If

Set CL = Range("A2:A" & Dlig).Find(What:=Me.TBoxM3.Value, LookIn:=xlValues, LookAt:=xlWhole)
   If ChkB01.Value = True Then
   Sheets("Base").Range("DH" & CL.Row) = "NC"
   Else
   Sheets("Base").Range("DH" & CL.Row).ClearContents
   End If

End Sub

Etant donné qu'i y a la redondance de if/then/else, il y a un moyen de simplifier opur le même effet ?

Ce code permet, e n cliquant dans une checkbox, de mettre VRAI ou FAUX dans une liste de cases.

Merci par avance =)

Bonsoir,

J'ai dois exécuter une macro sur un fichier Excel contenant plus de 200 milles lignes. J'ai fais une macro pour faire le travail, la macro fonctionne bien mais elle prend beaucoup trop de temps (2 à 3h de temps d'exécution : littéralement).

Je pense que c'est possible de diminuer le temps de calcul en utilisant la variable tableau sur Excel mais je n'arrive pas à le faire. Pouvez-vous m'aider svp?

Le fichier est en pièce jointe.

Bonne année

Bonsoir,

J'ai dois exécuter une macro sur un fichier Excel contenant plus de 200 milles lignes. J'ai fais une macro pour faire le travail, la macro fonctionne bien mais elle prend beaucoup trop de temps (2 à 3h de temps d'exécution : littéralement).

Je pense que c'est possible de diminuer le temps de calcul en utilisant la variable tableau sur Excel mais je n'arrive pas à le faire. Pouvez-vous m'aider svp?

Voici-le code :

Sub Tarif()

Dim a As Long

Dim temps%

Dim periode%

Dim intervalleDeTemps As Long

Dim ValeurCI As Long

Dim ValeurCRD As Long

Dim Offre As Long

Dim PlageCalcul As Long

Application.ScreenUpdating = False

PlageCalcul = Sheets("Membres").Range("A" & Rows.Count).End(xlUp).Row

For a = 2 To PlageCalcul

temps = 0

intervalleDeTemps = 0

Offre = 0

primepercue = 0

periode = Sheets("Membres").Cells(a, 5)

Sheets("Feuil3").Select

Sheets("Feuil3").Cells(1, 11) = a

Range("J1").Select

ActiveCell.FormulaR1C1 = periode

'Range("J1") = periode

Range("J2").Select

temps = Sheets("Membres").Cells(a, 3)

intervalleDeTemps = Sheets("Membres").Cells(a, 9)

Offre = Sheets("Membres").Cells(a, 2)

ValeurCI = Offre * Sheets("Feuil3").Cells(40, 7 + temps) * intervalleDeTemps / 100000

Sheets("Membres").Cells(a, 13) = ValeurCI

ValeurCRD = Offre * WorksheetFunction.Sum(Range(Sheets("Feuil3").Cells(42, 7 + temps), Sheets("Feuil3").Cells(41 + intervalleDeTemps, 7 + temps))) / 100000

Sheets("Membres").Cells(a, 14) = ValeurCRD

Next a

Application.ScreenUpdating = True

End Sub

Bonjour à la communauté,

Je sollicite une nouvelle fois les personnes du forum pour simplifier mon code VBA que j'ai créé uniquement avec l'enregistreur. Problème, il fait bugger les (vieux) PC sous Windows sous lesquels le fichier est utilisé (personnellement il fonctionne plutôt rapidement, je travail sur Mac plutôt récent).

Une âme charitable, s'il vous plait, pour m'aider à la simplification de mon enregistrement de commande VBA? Ce code prend les données qui me sont utiles dans les 2 premières feuilles (extraction de données via un site internet) et les ajoutes sur une troisième feuille : "Result". Cette dernière représente la base de mon traitement de données pour la suite de mon fichier.. Bref, voici mon code actuel:

Sub ClicOne()

'

' ClicOne Macro

Sheets("Extract payment").Select

Columns("D:D").Select

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns("C:C").Select

Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _

Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _

:=Array(Array(1, 1), Array(2, 1))

Columns("C:C").Select

Selection.Copy

Sheets("Result").Select

Columns("B:B").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("D:D").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("C:C").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("F:F").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("D:D").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("J:J").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("G:G").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("L:L").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("H:H").Select

ActiveSheet.Paste

Sheets("Extract payment").Select

Columns("P:P").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Result").Select

Columns("I:I").Select

ActiveSheet.Paste

Range("E1").Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "Owner name"

Range("E2").Select

ActiveCell.FormulaR1C1 = _

"=IF(ISNA(INDEX('Extract account'!C[20],MATCH(Result!RC[-1],'Extract account'!C[-3],0))),"""",(INDEX('Extract account'!C[20],MATCH(Result!RC[-1],'Extract account'!C[-3],0))))"

Range("D2").Select

Selection.Copy

Range("E2").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

Selection.AutoFill Destination:=Range("E2:E9"), Type:=xlFillDefault

Range("E2:E9").Select

Selection.AutoFill Destination:=Range("E2:E7042"), Type:=xlFillDefault

Range("E2:E7042").Select

Range("F1").Select

ActiveCell.FormulaR1C1 = "Account status"

Range("F2").Select

ActiveCell.FormulaR1C1 = _

"=IF(ISNA(INDEX('Extract account'!C[3],MATCH(Result!RC[-2],'Extract account'!C[-4],0))),"""",(INDEX('Extract account'!C[3],MATCH(Result!RC[-2],'Extract account'!C[-4],0))))"

Range("E2").Select

Selection.Copy

Range("F2").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

Selection.AutoFill Destination:=Range("F2:F7006"), Type:=xlFillDefault

Range("F2:F7006").Select

Range("J1").Select

ActiveCell.FormulaR1C1 = "Costumer Region"

Range("H1").Select

Selection.Copy

Range("J1").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

Range("J2").Select

ActiveCell.FormulaR1C1 = _

"=IF(ISNA(INDEX('Extract account'!C[22],MATCH(Result!RC[-6],'Extract account'!C[-8],0))),"""",(INDEX('Extract account'!C[22],MATCH(Result!RC[-6],'Extract account'!C[-8],0))))"

Range("J2").Select

Selection.AutoFill Destination:=Range("J2:J3"), Type:=xlFillDefault

Range("J2:J3").Select

Range("I2").Select

Selection.Copy

Range("J2").Select

Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Application.CutCopyMode = False

Selection.AutoFill Destination:=Range("J2:J7022"), Type:=xlFillDefault

Range("J2:J7022").Select

Columns("B:J").Select

Range("J1").Activate

With Selection

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.MergeCells = False

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.ShrinkToFit = False

.MergeCells = False

End With

Selection.ColumnWidth = 18.33

Range("C1:J1").Select

Range("J1").Activate

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Range("A11").Select

End Sub

Vous pouvez voir que c'est long et que ça doit bien faire mouliner les PC..

Je rajouterai que ce code est la première partie d'un outil que je souhaite développer avec plusieurs autres macro pour lesquels j'ai déjà sollicité les membres de la communauté ici. Du coup, ce premier code plutôt "pompeux" et peu rapide, ralenti vraiment l'outil.

Le fichier est également en pièce jointe.

Merci à tous pour l'aide sur ce site et merci d'avance aux personnes qui s'arrêterons pour m'aider!

Bonne journée à tous.

14test-forum.xlsm (408.32 Ko)

Bonjour le Forum,

Je demande votre aide pour voir si il y a moyen de simplifier voir d'améliorer le code de mon fichier. Suite à une mise à jour d'un texte règlementaire je suis obligé de refondre mon fichier qui était très basique au début, et tant qu'a le refaire autant l'améliorer. Du coup histoire de l'alléger je voudrais me servir de chacun des onglets qui représentent un point de graissage sur la voie ferrée, chacun de ces points ont un pas de visite de 3 ou 6 mois. Pour le moment je me suis débrouiller a "coder" avec l'enregistreur de macro, en compilant plusieurs actions. Le résultat est satisfaisant pour l’onglet 1, mais j'en ai 16 et du coup je peux recopier le code en changeant les "adresses" des données à copier, mais je ne suis pas convaincu que cela soit la meilleure méthode.

Au final mes compilations feront que j’aurai un bouton qui exécutera une macro 3mois, une 6 mois et une générale pour l’année.

Voici mon fichier en pièce jointe le but étant de le faire le plus « léger »possible pour des échanges par mails et avec nos pc qui datent d’une autre génération que tout soit « light » pour un usage simple et efficace.

En vous remerciant du temps passé

Didier

Bonjour à tous, je suis a un niveau plus que débutant en VBA et pour tout vous avouer, ma façon de faire est très scolaire. Le plus souvent pour faire une macro j'utilise le mode enregistrement et j’effectue une suite de manipulation, et cela se termine par un arrêt qui sauvegarde. Jusque la j'arrivais avec plus ou moins de réussite à obtenir ce que je voulais en complétant ces "macros" avec pas mal de formules dans les cellules pour arriver a mes fins.

Je vous sollicite donc pour m'aider à simplifier "mon" code, de mon coté je suis les cours sur le forum pour compléter mes lacunes mais étant autodidacte que ce soir en Excel et maintenant en VBA un peu de mal à raccrocher les wagons.

Pour vous expliquer en quoi mon fichier consiste, il s’agit d'un fichier pour éditer un carnet de bord pour l'ensemble des véhicules de mon secteur d'activités. L’idée est que chaque onglet reprenne un model en référence, et que chaque feuille se compose de la semaine 1 à 52(53) avec chaque jours de la semaine pour noter l'état ou autre sur chaque véhicule. Je me suis débrouillé pour faire le model et trouver si l'année avait 52 ou 53 semaines. Mais mon souci est que je n'arrive pas à ajouter ces données dans le code...

voici mon code

Sub Macro1()

'

Application.ScreenUpdating = False

'fiche 1

Sheets("model").Copy After:=Sheets(2)

Sheets("model (2)").Name = "1"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "=model!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "=model!RC+1"

'fiche 2

Sheets("1").Copy After:=Sheets(3)

Sheets("1 (2)").Name = "2"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='1'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='1'!RC:R[1]C+1"

'fiche 3

Sheets("2").Copy After:=Sheets(4)

Sheets("2 (2)").Name = "3"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='2'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='2'!RC:R[1]C+1"

'fiche 4

Sheets("3").Copy After:=Sheets(5)

Sheets("3 (2)").Name = "4"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='3'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='3'!RC:R[1]C+1"

'fiche 5

Sheets("4").Copy After:=Sheets(6)

Sheets("4 (2)").Name = "5"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='4'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='4'!RC:R[1]C+1"

'fiche 6

Sheets("5").Copy After:=Sheets(7)

Sheets("5 (2)").Name = "6"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='5'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='5'!RC:R[1]C+1"

'fiche 7

Sheets("6").Copy After:=Sheets(8)

Sheets("6 (2)").Name = "7"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='6'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='6'!RC:R[1]C+1"

'fiche 8

Sheets("7").Copy After:=Sheets(9)

Sheets("7 (2)").Name = "8"

Range("A6").Select

ActiveCell.FormulaR1C1 = "='7'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='7'!RC:R[1]C+1"

'fiche 9

Sheets("8").Copy After:=Sheets(10)

Sheets("8 (2)").Name = "9"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='8'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='8'!RC:R[1]C+1"

'fiche 10

Sheets("9").Copy After:=Sheets(11)

Sheets("9 (2)").Name = "10"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='9'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='9'!RC:R[1]C+1"

'fiche 11

Sheets("10").Copy After:=Sheets(12)

Sheets("10 (2)").Name = "11"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='10'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='10'!RC:R[1]C+1"

'fiche 12

Sheets("11").Copy After:=Sheets(13)

Sheets("11 (2)").Name = "12"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='11'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='11'!RC:R[1]C+1"

'fiche 13

Sheets("12").Copy After:=Sheets(14)

Sheets("12 (2)").Name = "13"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='12'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='12'!RC:R[1]C+1"

'fiche 14

Sheets("13").Copy After:=Sheets(15)

Sheets("13 (2)").Name = "14"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='13'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='13'!RC:R[1]C+1"

'fiche 15

Sheets("14").Copy After:=Sheets(16)

Sheets("14 (2)").Name = "15"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='14'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='14'!RC:R[1]C+1"

'fiche 16

Sheets("15").Copy After:=Sheets(17)

Sheets("15 (2)").Name = "16"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='15'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='15'!RC:R[1]C+1"

'fiche 17

Sheets("16").Copy After:=Sheets(18)

Sheets("16 (2)").Name = "17"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='16'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='16'!RC:R[1]C+1"

'fiche 18

Sheets("17").Copy After:=Sheets(19)

Sheets("17 (2)").Name = "18"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='17'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='17'!RC:R[1]C+1"

'fiche 19

Sheets("18").Copy After:=Sheets(20)

Sheets("18 (2)").Name = "19"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='18'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='18'!RC:R[1]C+1"

'fiche 20

Sheets("19").Copy After:=Sheets(21)

Sheets("19 (2)").Name = "20"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='19'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='19'!RC:R[1]C+1"

'fiche 21

Sheets("20").Copy After:=Sheets(22)

Sheets("20 (2)").Name = "21"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='20'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='20'!RC:R[1]C+1"

'fiche 22

Sheets("21").Copy After:=Sheets(23)

Sheets("21 (2)").Name = "22"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='21'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='21'!RC:R[1]C+1"

'fiche 23

Sheets("22").Copy After:=Sheets(24)

Sheets("22 (2)").Name = "23"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='22'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='22'!RC:R[1]C+1"

'fiche 24

Sheets("23").Copy After:=Sheets(25)

Sheets("23 (2)").Name = "24"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='23'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='23'!RC:R[1]C+1"

'fiche 25

Sheets("24").Copy After:=Sheets(26)

Sheets("24 (2)").Name = "25"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='24'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='24'!RC:R[1]C+1"

'fiche 26

Sheets("25").Copy After:=Sheets(27)

Sheets("25 (2)").Name = "26"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='25'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='25'!RC:R[1]C+1"

'fiche 27

Sheets("26").Copy After:=Sheets(28)

Sheets("26 (2)").Name = "27"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='26'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='26'!RC:R[1]C+1"

'fiche 28

Sheets("27").Copy After:=Sheets(29)

Sheets("27 (2)").Name = "28"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='27'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='27'!RC:R[1]C+1"

'fiche 29

Sheets("28").Copy After:=Sheets(30)

Sheets("28 (2)").Name = "29"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='28'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='28'!RC:R[1]C+1"

'fiche 30

Sheets("29").Copy After:=Sheets(31)

Sheets("29 (2)").Name = "30"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='29'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='29'!RC:R[1]C+1"

'fiche 31

Sheets("30").Copy After:=Sheets(32)

Sheets("30 (2)").Name = "31"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='30'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='30'!RC:R[1]C+1"

'fiche 32

Sheets("31").Copy After:=Sheets(33)

Sheets("31 (2)").Name = "32"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='31'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='31'!RC:R[1]C+1"

'fiche 33

Sheets("32").Copy After:=Sheets(34)

Sheets("32 (2)").Name = "33"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='32'!R[12]C+1"

Range("F2").Select

'fiche 34

Sheets("33").Copy After:=Sheets(35)

Sheets("33 (2)").Name = "34"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='33'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='33'!RC:R[1]C+1"

'fiche 35

Sheets("34").Copy After:=Sheets(36)

Sheets("34 (2)").Name = "35"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='34'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='34'!RC:R[1]C+1"

'fiche 36

Sheets("35").Copy After:=Sheets(37)

Sheets("35 (2)").Name = "36"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='35'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='35'!RC:R[1]C+1"

'fiche 37

Sheets("36").Copy After:=Sheets(38)

Sheets("36 (2)").Name = "37"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='36'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='36'!RC:R[1]C+1"

'fiche 38

Sheets("37").Copy After:=Sheets(39)

Sheets("37 (2)").Name = "38"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='37'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='37'!RC:R[1]C+1"

'fiche 39

Sheets("38").Copy After:=Sheets(40)

Sheets("38 (2)").Name = "39"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='38'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='38'!RC:R[1]C+1"

'fiche 40

Sheets("39").Copy After:=Sheets(41)

Sheets("39 (2)").Name = "40"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='39'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='39'!RC:R[1]C+1"

'fiche 41

Sheets("40").Copy After:=Sheets(42)

Sheets("40 (2)").Name = "41"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='40'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='40'!RC:R[1]C+1"

'fiche 42

Sheets("41").Copy After:=Sheets(43)

Sheets("41 (2)").Name = "42"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='41'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='41'!RC:R[1]C+1"

'fiche 43

Sheets("42").Copy After:=Sheets(44)

Sheets("42 (2)").Name = "43"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='42'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='42'!RC:R[1]C+1"

'fiche 44

Sheets("43").Copy After:=Sheets(45)

Sheets("43 (2)").Name = "44"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='43'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='43'!RC:R[1]C+1"

'fiche 45

Sheets("44").Copy After:=Sheets(46)

Sheets("44 (2)").Name = "45"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='44'!R[12]C+1"

Range("F2").Select

'fiche 46

Sheets("45").Copy After:=Sheets(47)

Sheets("45 (2)").Name = "46"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='45'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='45'!RC:R[1]C+1"

'fiche 47

Sheets("46").Copy After:=Sheets(48)

Sheets("46 (2)").Name = "47"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='46'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='46'!RC:R[1]C+1"

'fiche 48

Sheets("47").Copy After:=Sheets(49)

Sheets("47 (2)").Name = "48"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='47'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='47'!RC:R[1]C+1"

'fiche 49

Sheets("48").Copy After:=Sheets(50)

Sheets("48 (2)").Name = "49"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='48'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='48'!RC:R[1]C+1"

'fiche 50

Sheets("49").Copy After:=Sheets(51)

Sheets("49 (2)").Name = "50"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='49'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='49'!RC:R[1]C+1"

'fiche 51

Sheets("50").Copy After:=Sheets(52)

Sheets("50 (2)").Name = "51"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='50'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='50'!RC:R[1]C+1"

'fiche 52

Sheets("51").Copy After:=Sheets(53)

Sheets("51 (2)").Name = "52"

'changement de date et de numero de semaine

Range("A6").Select

ActiveCell.FormulaR1C1 = "='51'!R[12]C+1"

Range("F2").Select

ActiveCell.FormulaR1C1 = "='51'!RC:R[1]C+1"

'selection des onglets

Sheets(Array("model", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", _

"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24")).Select

Sheets("model").Activate

Sheets(Array("25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", _

"38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49")).Select Replace _

:=False

Sheets(Array("50", "51", "52")).Select Replace:=False

Sheets(Array("model", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", _

"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "52")).Select

Sheets("52").Activate

Sheets(Array("24", "25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", _

"37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48")).Select Replace _

:=False

Sheets(Array("49", "50", "51")).Select Replace:=False

'impression du fichier pdf creator

Application.ActivePrinter = "PDFCreator sur Ne00:"

ExecuteExcel4Macro _

"PRINT(1,,,1,,,,,,,,2,""PDFCreator sur Ne00:"",,TRUE,,FALSE)"

Range("B2:C3").Select

Selection.Copy

'suppression des onglets aprés travail

Sheets(Array("model", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", _

"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24")).Select

Sheets("1").Activate

Sheets(Array("25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", _

"38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49")).Select Replace _

:=False

Sheets(Array("50", "51", "52")).Select Replace:=False

Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", _

"16", "17", "18", "19", "20", "21", "22", "23", "24", "25")).Select

Sheets("1").Activate

Sheets(Array("26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", _

"39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50")).Select Replace _

:=False

Sheets(Array("51", "52")).Select Replace:=False

Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", _

"16", "17", "18", "19", "20", "21", "22", "23", "24", "52")).Select

Sheets("52").Activate

Sheets(Array("25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", _

"38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49")).Select Replace _

:=False

Sheets(Array("50", "51")).Select Replace:=False

Application.CutCopyMode = False

ActiveWindow.SelectedSheets.Delete

Sheets("Initialisation").Select

End Sub

comme vous pouvez le voir ma methode ne casse pas des briques, et je ne peux l'ameliorer seul pour l'instant

Merci de votre aide

Bonjour à tous,

Le code que je vais poster fonctionne mais est-il possible de le simplifier ? Car je travaille sur plusieurs tcd en même temps qui ont tous le même Pivotfields (Mois) et je veux qu'ils fassent tous la même chose.

Donc :

1 - Peut-on sélectionner plusieurs tcd en même temps pour ne pas avoir à recopier le même code à chaque changement de tcd?

(Du genre ActiveSheet.PivotTables("Tableau croisé dynamique3; Tableau croisé dynamique4").PivotFields("Mois")

2 - Sachant que je cache tout les pivotitems, n'est-il pas possible de faire la même chose?

(.PivotItems("1, 2, 3, 4, 5, ..., 24").Visible = False ou alors .PivotItems(All).Visible = False)

Mon code ne s'arrête pas à la fin de celui que je poste, d'autres choses s’enchaînent ensuite, mais en comprenant la technique, je pourrais ensuite l'adapter

Sub cocherplusieursfichiers()
'
On Error Resume Next
Application.ScreenUpdating = False
        ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Mois"). _
        EnableMultiplePageItems = True
    With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Mois")
        .PivotItems("1").Visible = False
        .PivotItems("2").Visible = False
        .PivotItems("3").Visible = False
        .PivotItems("4").Visible = False
        .PivotItems("5").Visible = False
        .PivotItems("6").Visible = False
        .PivotItems("7").Visible = False
        .PivotItems("8").Visible = False
        .PivotItems("9").Visible = False
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        .PivotItems("16").Visible = False
        .PivotItems("17").Visible = False
        .PivotItems("18").Visible = False
        .PivotItems("19").Visible = False
        .PivotItems("20").Visible = False
        .PivotItems("21").Visible = False
        .PivotItems("22").Visible = False
        .PivotItems("23").Visible = False
        .PivotItems("24").Visible = False
    End With

        ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields("Mois"). _
        EnableMultiplePageItems = True
    With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields("Mois")
        .PivotItems("1").Visible = False
        .PivotItems("2").Visible = False
        .PivotItems("3").Visible = False
        .PivotItems("4").Visible = False
        .PivotItems("5").Visible = False
        .PivotItems("6").Visible = False
        .PivotItems("7").Visible = False
        .PivotItems("8").Visible = False
        .PivotItems("9").Visible = False
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        .PivotItems("16").Visible = False
        .PivotItems("17").Visible = False
        .PivotItems("18").Visible = False
        .PivotItems("19").Visible = False
        .PivotItems("20").Visible = False
        .PivotItems("21").Visible = False
        .PivotItems("22").Visible = False
        .PivotItems("23").Visible = False
        .PivotItems("24").Visible = False
        End With

        ActiveSheet.PivotTables("Tableau croisé dynamique4").PivotFields("Mois"). _
        EnableMultiplePageItems = True
    With ActiveSheet.PivotTables("Tableau croisé dynamique4").PivotFields("Mois")
        .PivotItems("1").Visible = False
        .PivotItems("2").Visible = False
        .PivotItems("3").Visible = False
        .PivotItems("4").Visible = False
        .PivotItems("5").Visible = False
        .PivotItems("6").Visible = False
        .PivotItems("7").Visible = False
        .PivotItems("8").Visible = False
        .PivotItems("9").Visible = False
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        .PivotItems("16").Visible = False
        .PivotItems("17").Visible = False
        .PivotItems("18").Visible = False
        .PivotItems("19").Visible = False
        .PivotItems("20").Visible = False
        .PivotItems("21").Visible = False
        .PivotItems("22").Visible = False
        .PivotItems("23").Visible = False
        .PivotItems("24").Visible = False
        End With

        ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields("Mois"). _
        EnableMultiplePageItems = True
    With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields("Mois")
        .PivotItems("1").Visible = False
        .PivotItems("2").Visible = False
        .PivotItems("3").Visible = False
        .PivotItems("4").Visible = False
        .PivotItems("5").Visible = False
        .PivotItems("6").Visible = False
        .PivotItems("7").Visible = False
        .PivotItems("8").Visible = False
        .PivotItems("9").Visible = False
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        .PivotItems("16").Visible = False
        .PivotItems("17").Visible = False
        .PivotItems("18").Visible = False
        .PivotItems("19").Visible = False
        .PivotItems("20").Visible = False
        .PivotItems("21").Visible = False
        .PivotItems("22").Visible = False
        .PivotItems("23").Visible = False
        .PivotItems("24").Visible = False
    End With

'.... Enchainement du reste du code ....

Application.ScreenUpdating = True
 End Sub

En vous remerciant !

Bonjour,

Je suis débutant en la matière

Comment puis-je simplifier ce code afin que sa s’exécute beaucoup plus vite ?

Voici la liste de code:

Sheets("départ").Range("1:1").Insert
Sheets("départ").Range("a1").Value = Sheets("feuil13").Range("e7")
Sheets("départ").Range("b1").Value = Sheets("feuil13").Range("h1") & " " & Sheets("feuil13").Range("e7")
Sheets("départ").Range("c1").Value = Sheets("feuil13").Range("h2") & " " & Sheets("feuil13").Range("e7")
Sheets("départ").Range("d1").Value = Sheets("feuil13").Range("h3") & " " & Sheets("feuil13").Range("e7")
Sheets("départ").Range("e1").Value = Sheets("feuil13").Range("h4") & " " & Sheets("feuil13").Range("e7")
Sheets("départ").Range("f1").Value = Sheets("feuil13").Range("h5") & " " & Sheets("feuil13").Range("e7")
Sheets("départ").Range("g1").Value = Sheets("feuil13").Range("h6") & " " & Sheets("feuil13").Range("e7")
Sheets("départ").Range("h1").Value = Sheets("feuil13").Range("i1") & " " & Sheets("feuil13").Range("e8")
Sheets("départ").Range("i1").Value = Sheets("feuil13").Range("i2") & " " & Sheets("feuil13").Range("e8")
Sheets("départ").Range("j1").Value = Sheets("feuil13").Range("i3") & " " & Sheets("feuil13").Range("e8")
Sheets("départ").Range("k1").Value = Sheets("feuil13").Range("i4") & " " & Sheets("feuil13").Range("e8")
Sheets("départ").Range("l1").Value = Sheets("feuil13").Range("i5") & " " & Sheets("feuil13").Range("e8")
Sheets("départ").Range("m1").Value = Sheets("feuil13").Range("i6") & " " & Sheets("feuil13").Range("e8")
Sheets("départ").Range("o1").Value = Sheets("feuil13").Range("t18")
Sheets("départ").Range("p1").Value = Sheets("feuil13").Range("h7")
Sheets("départ").Range("q1").Value = Sheets("feuil13").Range("i7")
Sheets("départ").Range("r1").Value = Sheets("feuil13").Range("b1")
Sheets("départ").Range("s1").Value = Sheets("feuil13").Range("b8")
Sheets("départ").Range("t1").Value = Sheets("feuil13").Range("b5")
Sheets("départ").Range("u1").Value = Sheets("feuil13").Range("b6")
Sheets("départ").Range("v1").Value = Sheets("feuil13").Range("b9")
Sheets("départ").Range("w1").Value = Sheets("feuil13").Range("b10")
Sheets("départ").Range("x1").Value = Sheets("feuil13").Range("b11")
Sheets("départ").Range("y1").Value = Sheets("feuil13").Range("b12")
Sheets("départ").Range("ae1").Value = Sheets("feuil13").Range("a22")
Sheets("départ").Range("af1").Value = Sheets("feuil13").Range("a27")
Sheets("départ").Range("ag1").Value = Sheets("feuil13").Range("a32")
Sheets("départ").Range("ah1").Value = Sheets("feuil13").Range("a37")
Sheets("départ").Range("ai1").Value = Sheets("feuil13").Range("a42")
Sheets("départ").Range("aj1").Value = Sheets("feuil13").Range("a47")
Sheets("départ").Range("ak1").Value = Sheets("feuil13").Range("e10")
Sheets("départ").Range("al1").Value = Sheets("feuil13").Range("e12")
Sheets("départ").Range("am1").Value = Sheets("feuil13").Range("e14")
Sheets("départ").Range("an1").Value = Sheets("feuil13").Range("e1")
Sheets("départ").Range("ao1").Value = Sheets("feuil13").Range("e2")
Sheets("départ").Range("ap1").Value = Sheets("feuil13").Range("b3")
Sheets("départ").Range("ba1").Value = Sheets("feuil13").Range("fc1")
Sheets("départ").Range("bb1").Value = Sheets("feuil13").Range("fd1")
Sheets("départ").Range("bc1").Value = Sheets("feuil13").Range("fe1")
Sheets("départ").Range("bd1").Value = Sheets("feuil13").Range("ff1")
Sheets("feuil57").Range("2:2").Insert
Sheets("feuil57").Range("a2") = Sheets("feuil13").Range("e1").Value
Sheets("feuil57").Range("b2") = Sheets("feuil13").Range("e2").Value
Sheets("feuil57").Range("c2").Value = Sheets("feuil13").Range("b5")
Sheets("feuil57").Range("d2").Value = Sheets("feuil13").Range("b6")
Sheets("feuil57").Range("e2").Value = Sheets("feuil13").Range("a2")
Sheets("feuil57").Range("f2").Value = Sheets("feuil13").Range("b9")
Sheets("feuil57").Range("g2").Value = Sheets("feuil13").Range("b10")
Sheets("feuil57").Range("h2").Value = Sheets("feuil13").Range("b12")
Sheets("feuil57").Range("i2").Value = Sheets("tickets départs").Range("c7")
Sheets("feuil57").Range("j2").Value = Sheets("tickets départs").Range("d7")
Sheets("feuil57").Range("k2").Value = Sheets("feuil13").Range("b9")
Sheets("feuil57").Range("l2").Value = Sheets("feuil13").Range("b12")
Sheets("feuil57").Range("m2").Value = Sheets("motif").Range("c46")
Sheets("feuil57").Range("n2").Value = Sheets("motif").Range("d46")
Sheets("feuil57").Range("o2").Value = Sheets("feuil13").Range("fg9")
Sheets("feuil57").Range("p2").Value = Sheets("feuil13").Range("fg12")
Sheets("feuil57").Range("k2").Value = Sheets("feuil13").Range("b9")
Sheets("feuil57").Range("q2").Value = Sheets("feuil13").Range("c15")
Sheets("feuil57").Range("r2").Value = Sheets("feuil13").Range("c16")
Sheets("feuil57").Range("s2").Value = Sheets("feuil13").Range("c17")
Sheets("feuil57").Range("t2").Value = Sheets("feuil13").Range("c18")
Sheets("feuil57").Range("u2").Value = Sheets("feuil13").Range("c19")
Sheets("feuil57").Range("v2").Value = Sheets("feuil13").Range("c20")
Sheets("feuil57").Range("w2").Value = Sheets("feuil13").Range("e15")
Sheets("feuil57").Range("x2").Value = Sheets("feuil13").Range("e16")
Sheets("feuil57").Range("y2").Value = Sheets("feuil13").Range("e17")
Sheets("feuil57").Range("z2").Value = Sheets("feuil13").Range("e18")
Sheets("feuil57").Range("aa2").Value = Sheets("feuil13").Range("e19")
Sheets("feuil57").Range("ab2").Value = Sheets("feuil13").Range("e20")
Sheets("feuil57").Range("ae2").Value = Sheets("feuil13").Range("e12")
Sheets("feuil57").Range("af2").Value = Sheets("feuil13").Range("e14")
Sheets("feuil57").Range("ac2").Value = Sheets("feuil13").Range("c15")
Sheets("feuil57").Range("ad2").Value = Sheets("feuil13").Range("e52")

Merci de vos réponses .

Bonjour à tous,

Je sollicite une nouvelle fois votre aide.

Malgré mes recherches je n'arrive pas à trouver où comprendre les codes VBA que je trouve pour l'adapter à ma situation.

Voilà mon problème, je souhaite tout simplement ouvrir une table de données fait sous Access dans une feuille déjà existante dans excel.

Quelqu'un peut t'il m'aider?

Merci

Bonjour à tous,

Dans le code suivant je suis arrivé au résultat que je voulais, par contre je suis sure qu'il y a moyen de réduire la 1ère partie mais ça je n'ai pas trouvé.

Dans ce code j'oblige les utilisateurs à remplir toute les cellules avant enregistrement, par contre je n'y suis arriver que en recopiant le code pour chaque cellule qui doit être remplie, C11--> C21, y a t-il un moyen plus simple?

Merci pour votre aide.

Option Explicit

Dim f As Worksheet

Dim lgn&

Sub Enregistrer()

Sheets("Suivi ODACS").Unprotect Password:="MDP"

Set f = Sheets("Suivi ODACS")

If Range("C11").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C11").Select

Exit Sub

End If

If Range("C12").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C12").Select

Exit Sub

End If

If Range("C13").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C13").Select

Exit Sub

End If

If Range("C14").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C14").Select

Exit Sub

End If

If Range("C15").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C15").Select

Exit Sub

End If

If Range("C16").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C16").Select

Exit Sub

End If

If Range("C17").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C17").Select

Exit Sub

End If

If Range("C18").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C18").Select

Exit Sub

End If

If Range("C19").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C19").Select

Exit Sub

End If

If Range("C20").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C20").Select

Exit Sub

End If

If Range("C21").Value = "" Then

MsgBox "Veuillez remplir tous les champs.", vbOKOnly + vbCritical

Range("C21").Select

Exit Sub

End If

If WorksheetFunction.CountA(Range("C11:C21")) > 0 Then

Range("C11:C21").Copy

lgn = f.Range("B1").CurrentRegion.Rows.Count + 1

f.Range("B" & lgn).PasteSpecial xlPasteValues, Transpose:=True

Application.CutCopyMode = False

MsgBox "Votre ODACS a bien été enregistrée."

Range("C11:C21").ClearContents

End If

Sheets("Suivi ODACS").Select

Range("A1").End(xlDown).Offset(1, 0).Select

Sheets("Suivi ODACS").Protect Password:="MDP"

Sheets("Encodage ODACS").Select

Range("C11").Select

End Sub

Bonjour tout le monde,

Novice dans l'utilisation de VBA je cherche à simplifier un petit bout de code afin de le rendre léger.

L'un de vous pourrait il m'aider.

Merci

Voici le bout de code

Dim plage1 As Range

Dim plage2 As Range

Dim plage3 As Range

Dim plage4 As Range

Dim plage5 As Range

Dim plage6 As Range

Dim plage7 As Range

Dim plage9 As Range

Dim plage10 As Range

Dim plage11 As Range

Dim plage12 As Range

Dim plage13 As Range

Dim plage14 As Range

Dim volume As Range

Set plage1 = Range("J5:AZ5")

Set plage2 = Range("J6:AZ6")

Set plage3 = Range("J7:AZ7")

Set plage4 = Range("J8:AZ8")

Set plage5 = Range("J9:AZ9")

Set plage6 = Range("J10:AZ10")

Set plage7 = Range("J11:AZ11")

Set plage8 = Range("J12:AZ12")

Set plage9 = Range("J13:AZ13")

Set plage10 = Range("J14:AZ14")

Set plage11 = Range("J15:AZ15")

Set plage12 = Range("J16:AZ16")

Set plage13 = Range("J17:AZ17")

Set plage14 = Range("J18:AZ18")

Range("I5").Value = Application.sum(plage1)

Range("I6").Value = Application.sum(plage2)

Range("I7").Value = Application.sum(plage3)

Range("I8").Value = Application.sum(plage4)

Range("I9").Value = Application.sum(plage5)

Range("I10").Value = Application.sum(plage6)

Range("I11").Value = Application.sum(plage7)

Range("I12").Value = Application.sum(plage8)

Range("I13").Value = Application.sum(plage9)

Range("I14").Value = Application.sum(plage10)

Range("I15").Value = Application.sum(plage11)

Range("I16").Value = Application.sum(plage12)

Range("I17").Value = Application.sum(plage13)

Range("I18").Value = Application.sum(plage14)

Bonjour,

J'essaye de me débrouiller en code, j'en tenter un truc et j'aurai avoir vos retours si la façon de faire, j'ai comme l'impression que c'est un peu lourd tout ça

Application.ScreenUpdating = False

Set F1 = Worksheets("repart")

With F1
Set Plage = .Range("N3:N59")

End With

For Z = 3 To 29 Step 1

For Each cell In Plage

cell.Select
If cell.Value = Cells(Z, 3).Value Then Selection.Interior.Color = F1.Cells(Z, 3).Interior.Color
If cell.Value = Cells(Z, 3).Value Then Selection.Font.Color = F1.Cells(Z, 3).Font.Color

cell.Select
If cell.Value = Cells(Z, 5).Value Then Selection.Interior.Color = F1.Cells(Z, 5).Interior.Color
If cell.Value = Cells(Z, 5).Value Then Selection.Font.Color = F1.Cells(Z, 5).Font.Color

cell.Select
If cell.Value = Cells(Z, 7).Value Then Selection.Interior.Color = F1.Cells(Z, 7).Interior.Color
If cell.Value = Cells(Z, 7).Value Then Selection.Font.Color = F1.Cells(Z, 7).Font.Color

cell.Select
If cell.Value = Cells(Z, 9).Value Then Selection.Interior.Color = F1.Cells(Z, 9).Interior.Color
If cell.Value = Cells(Z, 9).Value Then Selection.Font.Color = F1.Cells(Z, 9).Font.Color

Next

Next Z

Application.ScreenUpdating = True

End Sub

J'ai tenté de simplifier surtout les cell.Select mais la macro fonctionne plus par la suite

Si vous pouvez me dire comment vous faites pour simplifier un code

Merci pour votre aide

Bonjour à tous,

Dans le fichier joint vous trouverez la maquette simplifiée de ce que je cherche à obtenir dans un fichier qui a plus de 30 onglets.

Le code fonctionne correctement mais je cherche à savoir s'il n'y a pas un moyen de le simplifier pour qu'il ne rame pas à cause du nombre d'onglets présents dans mon fichier, ce qui est le cas aujourd'hui.

Par exemple je mets une étape qui affiche toutes les lignes et toutes les colonnes dans mon fichier mais je dois faire une ligne par onglet. Je n'ai pas réussi à utiliser une formule qui dirait affiche toutes les lignes et colonnes pour les onglets "INDIC 1", "INDIC 2", etc. En sachant qu'un nombre conséquent d'onglets ne sont pas concernés par cette macro, je ne peux donc pas dire : afficher toutes les lignes / colonnes du classeur Excel.

Idem pour la couleur, dans la partie "PERIODE" je dois mettre une ligne de code par onglet pour mettre les couleurs, est-il possible d'écrire : dans les onglets "INDIC 1" et "INDIC 2" de C4:C9 mettre telle couleur. Et pouvoir quand on affiche tout ou qu'on change de période que cette couleur disparaisse.

Le but de ce fichier c'est qu'en fonction du choix de l'entreprise et de la période un certain nombre de ligne et colonne soit masqués dans certains onglets du fichier et que certaines cellules soient colorisées. Et surtout qu'il soit plutôt fluide et si possible ne pas multiplier les lignes de codes.

Je suis débutante et autodidacte en VBA, ce qui peut expliquer que mon code ne soit pas très "scolaire" ni "pro".

Avez-vous des idées ou des pistes d'amélioration à me proposer svp?

Merci par avance!

2macro.xlsm (29.27 Ko)

Bonjour,

Je voudrais simplifier ou condenser mon code, qui marche bien, mais est ce qu'il est possible de faire une boucle sur ce code :

If Demande1BC.Value <> "" Then

    demande = Demande1BC.Value

    Set celluletrouvee = Worksheets(SECTEUR).Columns(4).Find(demande, lookat:=xlWhole)

    If celluletrouvee Is Nothing Then
        MsgBox "La demande n°" & demande & " est introuvable."
    Else
        celluletrouvee.Offset(0, 7) = TextBox2_NumBC.Value
        celluletrouvee.Offset(0, 8) = DTPicker2.Value
        celluletrouvee.Offset(0, 10) = TextBox2_DelaisBC.Value
        celluletrouvee.Offset(0, 13) = TextBox2_TotalBC.Value
    End If
End If

If Demande2BC.Value <> "" Then

    demande = Demande2BC.Value

    Set celluletrouvee = Worksheets(SECTEUR).Columns(4).Find(demande, lookat:=xlWhole)

    If celluletrouvee Is Nothing Then
        MsgBox "La demande n°" & demande & " est introuvable."
    Else
        celluletrouvee.Offset(0, 7) = TextBox2_NumBC.Value
        celluletrouvee.Offset(0, 8) = DTPicker2.Value
        celluletrouvee.Offset(0, 10) = TextBox2_DelaisBC.Value
        celluletrouvee.Offset(0, 13) = TextBox2_TotalBC.Value
    End If
End If

DEMNADE1BC et DEMANDE2BC sont des textBox, en tout il en a 12, c'est répétitif du coup je souhaiterai mettre ça sous forme de boucle mais je sais pas faire... HELP !

Merci

Bonjour Forum,

Serait-il possible de m'aider à simplifier le code de la macro ? En fait, je pense qu'il y a moyen d'avoir un code plus épuré et lisible que la version actuelle.

'Création de la feuille Analyse
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy Before:=Sheets(1)
    Sheets("Sheet1 (2)").Select
    Sheets("Sheet1 (2)").Name = "Analyse"
'Suppression des lignes d'entête 1 à 8 provenant de InfoRH
    Rows("1:8").Select
    Selection.Delete Shift:=xlUp
    Range("A65536").End(xlUp).Select
    Selection.Delete Shift:=xlUp
    Range("A65536").End(xlUp).Select
    Selection.Delete Shift:=xlUp
    Columns("O:P").Select
    Selection.Delete Shift:=xlToLeft
    Columns("P:P").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Delete Shift:=xlToLeft
'Ajout / nomme des colonnes pour l'analyse des candidatures et mise en forme
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Base"
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Étape Réussie"
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Admissibilité"
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Éligibilité"
    Sheets("Analyse").Select
    Range("O1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Pmed?"
    With ActiveCell.Characters(Start:=1, Length:=5).Font
        .Name = "ARIAL"
        .FontStyle = "Gras"
        .Size = 10
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("P1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "'12"
    With ActiveCell.Characters(Start:=1, Length:=2).Font
        .Name = "ARIAL"
        .FontStyle = "Gras"
        .Size = 10
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("Q1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "P%?"
    With ActiveCell.Characters(Start:=1, Length:=3).Font
        .Name = "ARIAL"
        .FontStyle = "Gras"
        .Size = 10
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("R1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "T%?"
    With ActiveCell.Characters(Start:=1, Length:=3).Font
        .Name = "ARIAL"
        .FontStyle = "Gras"
        .Size = 10
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    Range("S1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "recherchev(stxt("
    With ActiveCell.Characters(Start:=1, Length:=16).Font
        .Name = "ARIAL"
        .FontStyle = "Gras"
        .Size = 10
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
'Défini le nombre de ligne à considérer dans l'onglet Éligibilité
    Sheets("Éligibilité").Select
    ComptElig = ActiveSheet.UsedRange.Rows.Count - 2
    Range("G8").Select
        With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Concatener"
    With ActiveCell.Characters(Start:=1, Length:=10).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
'Macro Bordures tableau Analyse - Mous

    Sheets("Analyse").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .VerticalAlignment = xlCenter
        .ReadingOrder = xlContext
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .ReadingOrder = xlContext
    End With

Je vous remercie amplement.

Bonjour tout le monde,

Je viens vers vous pour un problème d'erreur dans une boucle et des conseils de structure

Sub crit_eval1(lettre, j)
Dim i As Byte

 For i = 1 To 100
  If Feuil1.Range("H" & i) = "4" And Feuil1.Range("H" & i) = lettre Then
   Feuil19.Range("A" & j, "B" & j).MergeCells = True
   Feuil19.Range("A" & j) = Feuil1.Range("B" & i)
   j = j + 1
  ElseIf Feuil1.Range("L" & i) = "4" And Feuil1.Range("H" & i) = lettre Then
   Feuil19.Range("A" & j, "B" & j).MergeCells = True
   Feuil19.Range("A" & j) = Feuil1.Range("B" & i)
   j = j + 1
  End If
 Next

End Sub

'rempli feuil19.colonne A
'avec lles crritères d'éval de feuil1.colonne A
Sub orga_criteval()

Dim j As Byte, nbA As Byte, nbB As Byte, nbC As Byte, nbD As Byte, nbE As Byte
Dim a As String, b As String, c As String, d As String, e As String

j = 5
a = "A"
b = "B"
c = "C"
d = "D"
e = "E"

nbA = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), a)
nbB = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), b)
nbC = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), c)
nbD = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), d)
nbE = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), e)

If Not (nbA = 0) Then
 Feuil19.Range("A" & j) = "Consignes et instructions"
 j = j + 1
 Call crit_eval1(a, j)

ElseIf Not (nbB = 0) Then
 Feuil19.Range("A" & j) = "Esprit d'équipe"
 j = j + 1
 For i = 1 To 100
 Call crit_eval1(b, j)

ElseIf Not (nbC = 0) Then
 Feuil19.Range("A" & j) = "Opérations"
 j = j + 1
 Call crit_eval1(c, j)

ElseIf Not (nbD = 0) Then
 Feuil19.Range("A" & j) = "Savoir être"
 j = j + 1
 Call crit_eval1(d, j)

ElseIf Not (nbE = 0) Then
 Feuil19.Range("A" & j) = "Savoir faire"
 j = j + 1
 Call crit_eval1(e, j)

End If

End Sub

Au bout du deuxième ElseIf *EsleIf not(nbC = 0) then*, j'ai l'erreur : Erreur de compilation Else sans if.

Comme j'écrivais toujours la même chose, j'ai copier-coller chaque ElseIf. J'ai essayé de mettre ce ElseIf en commentaire et l'erreur se met sur celui d'après. Donc j'ai tout réécrit, même résultat. J'ai tout recopier-coller, même résultat.

Voyez-vous quelle erreur j'ai faite ?

Aussi, si vous avez des conseils pour faire la même chose en simplifié, je suis preneuse sachant que je ne peux pas modifier les feuilles sources ci jointe (doc opératuer nv1 conf).

Ce que j'essaie de faire est de copier les critères d'évaluations de la feuille "opérateur niv 1"(Feuil1) du classeur du même nom dans la feuille "Matrice de compétences"(Feuil19) sous des titres selon qu'ils ont un A, un B, un C, un D ou un E sur la même ligne dans la colonne A dans Feuil1. Je suis obligé de passer par VBA vu que ce tableau doit se générer entièrement automatiquement (un bouton).

Le but final pour cette partie de mon programme (derniers sub dans le module) est de créer exactement la colonne A du fichier joint Matrice ref

Merci encore de me permettre de progresser grâce à vos conseils et réponses =D

Lucie

4matrice-ref.xlsx (30.39 Ko)

Bonsoir le forum,

Sur une de mes bases de données, après un ajout ou modification ou suppression via un userform se déroule plusieurs macros qui doivent être lourdes puisqu'elles font bugger excel avec un message "excel ne répond pas". Ce message disparaît assez vite et en 10/20s tout est rentré dans l’ordre. Sauf que ces 20s peuvent paraître courtes mais cette base subit des ajouts/modif/suppression des centaines de fois par jour soit beaucoup de seconde...

J'ai déjà simplifier quelques macros que j'avais écrit en vba mais je bloque sur celle ci-jointe "Extractionbase" que j'avais enregistré manuellement.

Son but est de copier toutes les données de la base sans doublons, les coller sur la feuille 3 et enfin trier dans l'ordre alphabétique ou croissant. Il me semble que c'est cette macro à l'origine des bugs. Le vrai problème est peut-être que ce genre de macro n'est pas adapté pour une base lourde en donnée...

Quelqu'un aurait-il une solution pour simplifier cette macro ?

Je vous en remercie d'avance

9transport.xlsm (76.94 Ko)

Bonjour,

J'ai une macro qui va chercher des données dans un autre classeur, mais pour qu'il soit fonctionnel il faut que le 2e classeur soit ouvert.

Auriez vous une solution pour faire fonctionner ce code sans avoir besoin d'ouvrir l'autre classeur ?

Sub CongéPerso()
Windows("BDD.xlsm").Activate
ligne = 2
While Cells(ligne, 1) <> ""
    If Cells(ligne, 1) = "CP" Then
        title_ = Cells(ligne, 1)
        start_ = Cells(ligne, 2)
        end_ = Cells(ligne, 3)
        Duration_ = Cells(ligne, 4)
        calendar_ = Cells(ligne, 5)
        Windows("DOC VIERGE DEMANDE CP PROJET.xlsm").Activate 'ouvre le doc en quest
        Sheets(calendar_).Select 'selectionne la feuille correspondant au nom du salarié
        lig = 11
            While Cells(lig, 1) <> ""
                lig = lig + 1
            Wend
        Cells(lig, 1) = " Du " & start_ & " Au " & end_
        Cells(lig, 3) = Duration_ / 24
        'Cells(lig, 1).Characters.Font.Bold = True (classeur protégé --> Erreur)
        Windows("BDD.xlsm").Activate
    End If
  ligne = ligne + 1
Wend
End Sub

Recherches récentes

pmuchronomsg boxmodifier filtressinonlundi ferieuserformgmaomariolocativemailprotectioncdblcocherdatebaie informatiquemfccopier collercuveriesuivi