Diminution de codes

Fermé

simba_2015 Messages postés 10 Date d'inscription mardi 4 août 2015 Statut Membre Dernière intervention 18 août 2015 - Modifié par simba_2015 le 11/08/2015 à 14:30
eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 - 18 août 2015 à 11:56

Bonjour,

voila, j'ai crée un fichier excel avec tout les codes ci dessous mais lorsque je les exécutes, la macro est longue à ce réaliser(bug).
Le fichier en question, à été créé pour le suivi d'un contrat en Angleterre.
Il passera bientôt en mode test.

Pouvez vous m'aidez à diminuer le temps de réalisation de mes macros ? je sais que l'on peut faire un B1 = C2 à la place d'un copie, paste mais avant de me lancer à modifier tout mon code, je voudrais savoir si sa en vaut la peine ?

De plus j'ai un autre petit soucie pas bien grave mais bon, la ligne 9 de a feuille 1 est masqué et lors de la première utilisation de ma macro pour complété cette feuilles, la ligne 9 ce remplie mais il ne détecte pas quel est rempli et ne passe jamais a la suivante (sauf si j'affiche cette ligne).

Voici mon fichier :

https://www.cjoint.com/c/EHlmADZjI0i

Bien évidement une mise en forme et une meilleur présentation sera réalisée une fois le fichier validé.

1/macro pour copier la date et heure et pour recopier les informations dans le bon fichier.


Option Explicit
Sub copie_date_and_hours()
'
' copie_heure Macro
'

    If Cells(4, 2) = 12 Then
    Range("L1").Select
    Selection.Copy
    Range("B15").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
    Range("K1").Select
    Selection.Copy
    Range("B20").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B6").Select
    End If
    
End Sub
Sub copie_IMAC()
'
' copie_IMAC Macro
'

'
Dim DLig As Long
Dim x As String

If Cells(4, 2) = 1 Or Cells(4, 2) = 5 Or Cells(4, 2) = 6 Or Cells(4, 2) = 7 Or Cells(4, 2) = 9 Or Cells(4, 2) = 10 Then
x = Cells(4, 2)
Sheets(x).Select
DLig = Range("E" & Rows.Count).End(xlUp).Row
Sheets("New job").Select
    Range("B6").Select
    Selection.Copy
    Sheets(x).Select
    Range("K" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(x).Select
    Range("D" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(x).Select
    Range("F" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(x).Select
    Range("E" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(x).Select
    Range("I" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(x).Select
    Range("C" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(x).Select
    Range("M" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(x).Select
    Range("N" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Application.CutCopyMode = False
   
    End If
    
    If Cells(4, 2) = 8 Or Cells(4, 2) = 11 Or Cells(4, 2) = 13 Then
Dim y As String
y = Cells(4, 2)
Sheets(y).Select
DLig = Range("D" & Rows.Count).End(xlUp).Row
Sheets("New job").Select
    Range("B6").Select
    Selection.Copy
    Sheets(y).Select
    Range("J" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("E" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("D" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("C" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("B" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("G" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("F" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("L" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("M" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(y).Select
    Range("H" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Application.CutCopyMode = False
    End If
    
If Cells(4, 2) = 12 Then
Sheets("12").Select
DLig = Range("B" & Rows.Count).End(xlUp).Row
Sheets("New job").Select
    Range("B6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("K" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("E" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("F" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("D" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("I" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("N" & DLig + 1).Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("New job").Select
    Range("B15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("O" & DLig + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Sheets("New job").Select
    Range("B17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("L" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("Q" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("M" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("B" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("12").Select
    Range("C" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Application.CutCopyMode = False
End If

If Cells(4, 2) = 1 Or Cells(4, 2) = 5 Or Cells(4, 2) = 6 Or Cells(4, 2) = 7 Or Cells(4, 2) = 9 Or Cells(4, 2) = 10 Then
Sheets("ALL").Select
DLig = Range("B" & Rows.Count).End(xlUp).Row
Sheets("New job").Select
    Range("B4").Select
    Selection.Copy
    Sheets("ALL").Select
    Range("B" & DLig + 1).Select
    ActiveSheet.Paste
    Range("B9").Select
    Selection.Copy
    Range("C" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B6").Select
    Selection.Copy
    Sheets("ALL").Select
    Range("N" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("E" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("I" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("H" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("L" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("F" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("D" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("Q" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("P" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Application.CutCopyMode = False
   
    End If
    
    If Cells(4, 2) = 3 Or Cells(4, 2) = 8 Or Cells(4, 2) = 11 Or Cells(4, 2) = 13 Then
Sheets("ALL").Select
DLig = Range("B" & Rows.Count).End(xlUp).Row
Sheets("New job").Select
    Range("B4").Select
    Selection.Copy
    Sheets("ALL").Select
    Range("B" & DLig + 1).Select
    ActiveSheet.Paste
    Range("B9").Select
    Selection.Copy
    Range("C" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B6").Select
    Selection.Copy
    Sheets("ALL").Select
    Range("N" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("I" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("L" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("G" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("D" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("K" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("J" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("H" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("Q" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("P" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ALL").Select
    Range("H" & DLig + 1).Select
    ActiveSheet.Paste
    Sheets("New job").Select
    Application.CutCopyMode = False
    End If
End Sub

2/ macro pour compléter le travail fini


Sub complete_job()
'déclaration des variables :
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String

Sheets("ALL").Select
Columns(22) = Columns(21).Value
'affectation de valeurs aux variables :
    'on cherche le mot "YES "
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(22)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
    AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("ALL").Select
    Range("R" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("ALL").Select
    Range("S" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("ALL").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing



Sheets("1").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("1").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("1").Select
    Range("P" & AdresseTrouvee).Select
    ActiveSheet.Paste
     Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("1").Select
    Range("L" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing


Sheets("5").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("5").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("5").Select
    Range("P" & AdresseTrouvee).Select
    ActiveSheet.Paste
     Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("5").Select
    Range("L" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Sheets("6").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("6").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("6").Select
    Range("P" & AdresseTrouvee).Select
    ActiveSheet.Paste
         Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("6").Select
    Range("L" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Sheets("7").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("7").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("7").Select
    Range("P" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("7").Select
    Range("L" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Sheets("8").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("8").Select
    Range("N" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("8").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
         Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("8").Select
    Range("K" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Sheets("9").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("9").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("9").Select
    Range("P" & AdresseTrouvee).Select
    ActiveSheet.Paste
         Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("9").Select
    Range("L" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Sheets("10").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("10").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("10").Select
    Range("P" & AdresseTrouvee).Select
    ActiveSheet.Paste
         Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("10").Select
    Range("L" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Sheets("11").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("11").Select
    Range("N" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("11").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
         Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("11").Select
    Range("K" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Sheets("13").Select
Columns(19) = Columns(18).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(19)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("13").Select
    Range("N" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("13").Select
    Range("O" & AdresseTrouvee).Select
    ActiveSheet.Paste
         Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("13").Select
    Range("K" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Sheets("12").Select
Columns(24) = Columns(23).Value
Valeur_Cherchee = "YES "
    'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(24)
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
  AdresseTrouvee = 0
  Else
      AdresseTrouvee = Trouve.Row

'MsgBox AdresseTrouvee

Sheets("Complete job").Select
    Range("C7").Select
    Selection.Copy
    Sheets("12").Select
    Range("R" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C10").Select
    Selection.Copy
    Sheets("12").Select
    Range("S" & AdresseTrouvee).Select
    ActiveSheet.Paste
   Sheets("Complete job").Select
    Range("C8").Select
    Selection.Copy
    Sheets("12").Select
    Range("T" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C9").Select
    Selection.Copy
    Sheets("12").Select
    Range("U" & AdresseTrouvee).Select
    ActiveSheet.Paste
    Sheets("Complete job").Select
    Range("C11").Select
    Selection.Copy
    Sheets("12").Select
    Range("P" & AdresseTrouvee).Select
    ActiveSheet.Paste
    End If
    
    Sheets("Complete job").Select
    Application.CutCopyMode = False
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing


End Sub

3/ code de récupération des données sur un fichier word


Option Explicit


Sub récup_word_fault_2()

    Dim wdapp As Word.Application
    Dim wdoc As Word.Document
    Dim objtable As Word.Table
    Dim nomfich As String
    Dim nomdufichier As String
    nomdufichier = "C:\Users\levasseur tony\AppData\Local\Microsoft\Windows\INetCache\Content.Outlook\PNPL3JQX\"
    nomfich = nomdufichier & Cells(4, 6) & ".doc"
     
    Set wdapp = CreateObject("Word.Application") 'creation session Word
    wdapp.Visible = True
    On Error Resume Next

    wdapp.Documents.Open Filename:=nomfich
    Set wdoc = wdapp.activeDocument
    Set objtable = wdoc.tables(1)

'2ème méthode : remplissage cellule par cellule
    With ActiveSheet
      Sheets("New job").Select
     ' .Cells(5, 6) = nomfich
        .Cells(4, 2) = 12
        .Cells(11, 2) = WorksheetFunction.Substitute(objtable.Cell(1, 2).Range.Text, Chr(7), "")
        .Cells(6, 2) = WorksheetFunction.Substitute(objtable.Cell(3, 2).Range.Text, Chr(7), "")
        ' building.Cells(17, 2) = WorksheetFunction.Substitute(objtable.Cell(7, 2).Range.Text, Chr(7), "")and (WorksheetFunction.Substitute(objtable.Cell(7, 5).Range.Text, Chr(7), "")
        .Cells(9, 2) = WorksheetFunction.Substitute(objtable.Cell(9, 6).Range.Text, Chr(7), "")
        .Cells(16, 2) = WorksheetFunction.Substitute(objtable.Cell(11, 5).Range.Text, Chr(7), "")
        .Cells(12, 2) = WorksheetFunction.Substitute(objtable.Cell(14, 1).Range.Text, Chr(7), "")
        
    End With
    wdoc.Close False
    wdapp.Quit

    If Cells(4, 2) = 12 Then
    Range("L1").Select
    Selection.Copy
    Range("B15").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
    Range("K1").Select
    Selection.Copy
    Range("B20").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B6").Select
    End If
    
End Sub

4/ code pour la remise a zero chaque moi une fois le fichier envoyé au client (remise à zéro seulement des lignes terminées).


Option Explicit
Sub RESET_fin_de_moi_1()

Dim i As Integer
Dim sel As String


    Range("A8:P39").Select
    Selection.AutoFilter
    Range("B8:P39").Select
    Selection.AutoFilter Field:=14, Criteria1:="YES "
   ' sel = ""
   ' ActiveCell.SpecialCells(xlLastCell).Select
   ' Range("A1").Select
   ' For i = 1 To 50
   '     If Range("O" & i).Value = "YES " Then
    '       sel = sel & i & ":" & i & ","
    '    End If
    '    Next
   ' sel = Left(sel, Len(sel) - 1)
   ' Range(sel).Select
   Range("B9:P39").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=14
    Range("A10:P39").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G10:H10").Select
    Selection.AutoFill Destination:=Range("G10:H39"), Type:=xlFillDefault
    Range("G10:H39").Select
    Range("B10").Select
    Selection.AutoFill Destination:=Range("B10:B39"), Type:=xlFillDefault
    Range("B10").Select
      Range("J10").Select
    Selection.AutoFill Destination:=Range("J10:J39"), Type:=xlFillDefault
    Range("J10").Select
   '     Rows("8:8").Select
  '  Selection.AutoFilter
  '  ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear
  '  ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add Key:=Range("A8" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
  '  With ActiveWorkbook.Worksheets("1").AutoFilter.Sort
  '      .Header = xlYes
  '      .MatchCase = False
   '     .Orientation = xlTopToBottom
  '      .SortMethod = xlPinYin
  '      .Apply
  '  End With
  Range("O9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
    'Cells(10, 1).Select
'Selection.EntireRow.Insert
   

End Sub

Sub RESET_fin_de_moi_5()
Range("A8:P120").Select
    Selection.AutoFilter
    Range("B8:P120").Select
    Selection.AutoFilter Field:=14, Criteria1:="YES "
    Range("B9:P120").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=14
    Range("A10:P120").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G10:H10").Select
    Selection.AutoFill Destination:=Range("G10:H120"), Type:=xlFillDefault
    Range("G10:H120").Select
    Range("B10").Select
    Selection.AutoFill Destination:=Range("B10:B120"), Type:=xlFillDefault
    Range("B10").Select
      Range("J10").Select
    Selection.AutoFill Destination:=Range("J10:J120"), Type:=xlFillDefault
    Range("J10").Select
    Range("O9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  
End Sub
Sub RESET_fin_de_moi_6()
Range("A8:P16").Select
    Selection.AutoFilter
    Range("B8:P16").Select
    Selection.AutoFilter Field:=14, Criteria1:="YES "
    Range("B9:P16").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=14
    Range("A10:P16").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G10:H10").Select
    Selection.AutoFill Destination:=Range("G10:H16"), Type:=xlFillDefault
    Range("G10:H16").Select
      Range("J10").Select
    Selection.AutoFill Destination:=Range("J10:J16"), Type:=xlFillDefault
    Range("J10").Select
    Range("O9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  
End Sub

Sub RESET_fin_de_moi_7()
Range("A8:P19").Select
    Selection.AutoFilter
    Range("B8:P19").Select
    Selection.AutoFilter Field:=14, Criteria1:="YES "
    Range("B9:P19").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=14
    Range("A10:P19").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G10:H10").Select
    Selection.AutoFill Destination:=Range("G10:H19"), Type:=xlFillDefault
    Range("G10:H19").Select
      Range("J10").Select
    Selection.AutoFill Destination:=Range("J10:J19"), Type:=xlFillDefault
    Range("J10").Select
    Range("O9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  
End Sub
Sub RESET_fin_de_moi_8()
Range("A8:P19").Select
    Selection.AutoFilter
    Range("B8:O19").Select
    Selection.AutoFilter Field:=13, Criteria1:="YES "
    Range("B9:O19").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=13
    Range("A10:O19").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   Range("I10").Select
    Selection.AutoFill Destination:=Range("I10:I19"), Type:=xlFillDefault
    Range("I10").Select
   Range("N9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  
End Sub

Sub RESET_fin_de_moi_9()
Range("A8:P24").Select
    Selection.AutoFilter
    Range("B8:P24").Select
    Selection.AutoFilter Field:=14, Criteria1:="YES "
    Range("B9:P24").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=14
    Range("A10:P24").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G10").Select
    Selection.AutoFill Destination:=Range("G10:G24"), Type:=xlFillDefault
    Range("G10").Select
     Range("B10").Select
    Selection.AutoFill Destination:=Range("B10:B24"), Type:=xlFillDefault
    Range("B10").Select
      Range("J10").Select
    Selection.AutoFill Destination:=Range("J10:J24"), Type:=xlFillDefault
    Range("J10").Select
    Range("O9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  
End Sub
Sub RESET_fin_de_moi_10()
Range("A8:P110").Select
    Selection.AutoFilter
    Range("B8:P110").Select
    Selection.AutoFilter Field:=14, Criteria1:="YES "
    Range("B9:P110").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=14
    Range("A10:P110").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G10").Select
    Selection.AutoFill Destination:=Range("G10:G110"), Type:=xlFillDefault
    Range("G10").Select
     Range("B10").Select
    Selection.AutoFill Destination:=Range("B10:B110"), Type:=xlFillDefault
    Range("B10").Select
      Range("J10").Select
    Selection.AutoFill Destination:=Range("J10:J110"), Type:=xlFillDefault
    Range("J10").Select
    Range("O9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  
End Sub
Sub RESET_fin_de_moi_11()
Range("A8:O17").Select
    Selection.AutoFilter
    Range("B8:O17").Select
    Selection.AutoFilter Field:=13, Criteria1:="YES "
    Range("B9:O17").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=13
    Range("A10:O17").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   Range("I10").Select
    Selection.AutoFill Destination:=Range("I10:I17"), Type:=xlFillDefault
    Range("I10").Select
   Range("N9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  End Sub
  Sub RESET_fin_de_moi_13()
Range("A8:O50").Select
    Selection.AutoFilter
    Range("B8:O50").Select
    Selection.AutoFilter Field:=13, Criteria1:="YES "
    Range("B9:O50").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=13
    Range("A10:O50").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
   Range("I10").Select
    Selection.AutoFill Destination:=Range("I10:I50"), Type:=xlFillDefault
    Range("I10").Select
   Range("N9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  End Sub
  
Sub RESET_fin_de_moi_12()
Range("A8:U124").Select
    Selection.AutoFilter
    Range("B8:U124").Select
    Selection.AutoFilter Field:=17, Criteria1:="YES "
    Range("B9:U124").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.ClearContents
    Selection.AutoFilter Field:=17
    Range("A10:U124").Select
    Selection.Sort Key1:=Range("E9"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("G10").Select
    Selection.AutoFill Destination:=Range("G10:G124"), Type:=xlFillDefault
    Range("G10").Select
     Range("H10").Select
    Selection.AutoFill Destination:=Range("H10:H124"), Type:=xlFillDefault
    Range("H10").Select
      Range("J10").Select
    Selection.AutoFill Destination:=Range("J10:J124"), Type:=xlFillDefault
    Range("J10").Select
       Range("C10").Select
    Selection.AutoFill Destination:=Range("C10:C124"), Type:=xlFillDefault
    Range("C10").Select
    Range("R9") = "YES "
  Rows("9:9").Select
  Selection.EntireRow.Hidden = True
  Range("A1").Select
  End Sub

Un grand merci a tout ceux qui aurons le courage de regarder ma publication jusqu'ici et encore un plus grand merci à tout ceux qui m'aiderons dans ma démarche.

A voir également:

Diminution de codes
Codes ascii - Guide
Codes secrets pour débloquer tous téléphones mobiles - Guide
Code de déverrouillage oublié - Guide
Mes codes personnels - Guide
Rm-014s+ universal remote codes pdf - Forum TV & Vidéo

5 réponses

Réponse 1 / 5

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 11/08/2015 à 16:16

Bonjour,

je sais que l'on peut faire un B1 = C2 à la place d'un copie, paste mais avant de me lancer à modifier tout mon code, je voudrais savoir si sa en vaut la peine ?

pas qu'un peu!
règle de base en VBA: éviter les sélect-sélection et les copy paste particulièrement chronophages

commence donc par modifier ca après on verra

d'autre part en début de macro
application.screenupdating=false pour le confort des yeux et la rapidité

Le mieux pour toi passer de l'enregistreur à VBA:
https://excel.developpez.com/cours/

urgent pour toi car je crains la réaction de ton client à la vue de ce code qui risque de t'envoyer à la comptabilité de ta boite...

Michel

Réponse 2 / 5

simba_2015 Messages postés 10 Date d'inscription mardi 4 août 2015 Statut Membre Dernière intervention 18 août 2015
11 août 2015 à 17:48

Tu sais j'apprend au fur et à mesure, j'avance doucement mais surement...
Je suis déjà très fière de moi d'être arrivé à mes fins! Désolé d'être novice.

J'ai fais les modification que tu m'as demandé.
Voici le nouveau fichier :
https://www.cjoint.com/c/EHlpSXRERDi

Réponse 3 / 5

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
11 août 2015 à 18:43

On a tous débuté: donc, ne sois pas désolée...

je regarderai demain à la fraiche
en attendant pour encadrer tes cellules

F.Range("O" & DLig + 1).borders.weight=xlthin

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
12 août 2015 à 10:29

Bonjour,

Ca avance mais beaucoup d'autres trucs à faire...
donc, sois patiente

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
12 août 2015 à 13:33

beaucoup d'autres trucs à faire...

hélas, je reprendrai + tard

simba_2015 Messages postés 10 Date d'inscription mardi 4 août 2015 Statut Membre Dernière intervention 18 août 2015
18 août 2015 à 08:55

patient mais merci

mon fichier pourrais t'il être amélioré en utilisant Access plutôt que excel ?

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303 > simba_2015 Messages postés 10 Date d'inscription mardi 4 août 2015 Statut Membre Dernière intervention 18 août 2015
18 août 2015 à 09:13

bonjour,

mon fichier pourrais t'il être amélioré en utilisant Access plutôt que excel ?

Bof !
il faudrait que tu me ré adresse ton classeur. j'avais une proposition mais je n'ai pas conserver le fichier. j'avais travaillé sur "copie_IMAC"

Réponse 4 / 5

simba_2015 Messages postés 10 Date d'inscription mardi 4 août 2015 Statut Membre Dernière intervention 18 août 2015
18 août 2015 à 10:02

Bonjour,

mon fichier et toujours disponible dans mon post précédent. il est en test depuis ce matin et c'est surtout l'enregistrement du fichier et la validation du completed job qui est très lente.

je ne peut pas le poster de nouveau car il fait plus de 30MO.

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
18 août 2015 à 11:35

Gros problème avec tes 2 envois de classeurs car après des écritures dans VBA enregistrées et fermeture du classeur, à la ré-ouverture et demande d'aller dans l'éditeur vba , j'ai un massage fatal: "erreur de chargement de la DLL" et je dois aller dans le gestionnaire des tâches pour sortir, le classeur est inutilisable

j'ai vérifié si ca ne venait pas de moi en allant sur des fichiers avec macros et je n'ai pas ce problème ni de virus après une analyse approfondie...

eriiic Messages postés 24570 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 23 avril 2024 7 213
Modifié par eriiic le 18/08/2015 à 12:06

Bonjour,

Gros problème avec tes 2 envois de classeurs...
Je confirme.
Même pas besoin d'éditer le vba. Après un simple 'Enregistrer sous...' en changeant le nom tout de suite après ouverture suffit à rendre le code inaccessible à l'ouverture suivante.
eric

edit: en fait le classeur se ferme bien mais le projet n'est pas déchargé. Si ça t'inspire michel

Discussions similaires

Code de vérification inconnu

IPTV CODE BLOQUÉ

programme qui n'affiche pas le mot secret

commen faire gestes technique sur ps3

Jeu avec réponses à donner

Discussions similaires

Newsletters