Application.Goto

Le 26/10/2021 à 10:49

Bonjour,

J'ai un macro qui va rechercher une date dans le classeur et de là, va coller une ligne de donnée sur cet emplacement et faire un tas d'autres choses en même temps.

Je n'arrive pas à faire qu'à la fin de cette macro l'écran affiche la feuille où les données ont été copiées sans un message d'erreur dans la macro arrive

ça fonction mais ça bloque ici

'afficher la feuille du mois de la saisie
   Sheets("Formulaire").Select
   Range("F1:G1").Select
   Application.Goto

Merci d'avance à ceux qui peuvent m'aider

Le 26/10/2021 à 10:58

Bonjour,

Une première chose qui serait sympa c'est de clôturer les fils pour lesquels vous avez reçu une réponse avec un petit remerciement pour ceux qui vous ont apporté une solution. Pour voir les fils ouverts, rendez-vous ici -> https://forum.excel-pratique.com/membre/76150

Je n'arrive pas à faire qu'à la fin de cette macro l'écran affiche la feuille où les données ont été copiées sans un message d'erreur dans la macro arrive
ça fonction mais ça bloque ici

Il n'y a pas assez d'éléments pour vous donner une solution. Sur quelle ligne cela bloque-t-il ?

Votre application.Goto ne sert à rien. Cela ne renvoie nulle part

Cordialement

Le 26/10/2021 à 10:58

Bonjour Noemi,

Il suffit d'utiliser

Sheets("MonMois").Activate

Attention au code de macro Excel 4 comme "GoTo"

https://support.microsoft.com/fr-fr/office/utilisation-de-macros-excel-4-0-ba8924d4-e157-4bb2-8d76-2...

@+

Edit : Salut Dan

Le 27/10/2021 à 15:31

je ne peux pas mettre le fichier, il est très volumineux...

je peux mettre le code en entier :

Sub EnvoyerSaisieMois()

'On Error Resume Next

Application.ScreenUpdating = False

'enlever protection feuilles des mois
    Sheets("Janvier").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Fevrier").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Mars").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Avril").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Mai").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Juin").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Juillet").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Aout").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Septembre").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Octobre").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Novembre").Select
    ActiveSheet.Unprotect ("test")
    Sheets("Decembre").Select
    ActiveSheet.Unprotect ("test")

'enlever la protection de la feuille
Sheets("Saisies").Select
    ActiveSheet.Unprotect ("test")

                'créer une nouvelle ligne
                Range("A2").Select
                Selection.ListObject.ListRows.Add (1)

            'remplir le tableau saisie
            Sheets("Formulaire").Select
            Range("A78:X78").Select
            Selection.Copy
            Sheets("Saisies").Select
            Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Application.CutCopyMode = False

Dim i As Integer
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant, Cherche
 Cherche = Worksheets("Saisies").Range("B2").Value
    NoCol = 2 'lecture de la colonne B
For i = 6 To 22 'feuilles
Set FL1 = Worksheets(Worksheets(i).Name)
   For NoLig = 2 To 37 'colonne B
        Var = FL1.Cells(NoLig, NoCol)
        If Var = Cherche Then
        Worksheets("Saisies").Range("B2:V2").Copy _
        Destination:=FL1.Cells(NoLig, 2)

        End If
    Next
Next

 'proteger feuille
 ActiveSheet.Protect "test", DrawingObjects:=True, Contents:=True, Scenarios:=True

     'masquer les lignes
     Sheets("Formulaire").Select
    Rows("9:1000").Select
    Selection.EntireRow.Hidden = True

    'afficher les lignes des catégories
    Rows("1:8").Select
    Selection.EntireRow.Hidden = False

    'explications
    Range("A9:K11").Select
    ActiveCell.FormulaR1C1 = ""

    'affichage de la catégorie
    Range("I1:L1").Select
    ActiveCell.FormulaR1C1 = ""

     Range("B12").Select
    ActiveCell.FormulaR1C1 = "=R[4]C"
    Range("D12").Select
    ActiveCell.FormulaR1C1 = "=R[4]C"
    Range("F12").Select
    ActiveCell.FormulaR1C1 = "=R[4]C"
    Range("H12").Select
    ActiveCell.FormulaR1C1 = "=R[4]C"
    Range("J12").Select
    ActiveCell.FormulaR1C1 = "=R[4]C"
    Range("L12").Select
    ActiveCell.FormulaR1C1 = "=R[4]C"
    Range("L16").Select

    Range("A15:C15").ClearContents
    Range("D15").ClearContents
    Range("A18").ClearContents
    Range("F21:I21").ClearContents
    Range("A23:C23").ClearContents
    Range("A25:C25").ClearContents
    Range("A27:C27").ClearContents
    Range("A29:C29").ClearContents
    Range("A31:B31").ClearContents
    Range("A33:C33").ClearContents
    Range("A35:C35").ClearContents
    Range("A37:C37").ClearContents
    Range("A39:C39").ClearContents
    Range("A41:B41").ClearContents
    Range("A43:C43").ClearContents
    Range("A45:B45").ClearContents
    Range("A47:C47").ClearContents
    Range("A49:C49").ClearContents
    Range("A51:B51").ClearContents
    Range("A53:B53").ClearContents
    Range("A55:B55").ClearContents
    Range("C57").ClearContents
    Range("C57").ClearContents
    Range("E59").ClearContents
    Range("K59").ClearContents
    Range("E62").ClearContents
    Range("F57:I57").ClearContents
    Range("A72:N72").ClearContents
    Range("I26").ClearContents
    Range("I36").ClearContents
    Range("I38").ClearContents
    Range("I42").ClearContents
    Range("R81").ClearContents
    Range("I65:K66").ClearContents
    Range("N23").ClearContents
    Range("N25").ClearContent
    Range("H65:N65").ClearContents
    Range("L66:M66").ClearContents
    Range("N27").ClearContents
    Range("N29").ClearContents
    Range("N37").ClearContents
    Range("N39").ClearContents
    Range("N33").ClearContents
    Range("N43").ClearContents
    Range("N47").ClearContents
    Range("N49").ClearContents
    Range("K40:L40").ClearContents
    Range("K44:L44").ClearContents
    Range("I50:J50").ClearContents
    Range("I52:J52").ClearContents
    Range("I54:J54").ClearContents

    Range("I50:J50").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13619151
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Range("I52:J52").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13619151
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Range("I54:J54").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13619151
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

  ' EffacerContenuTableau Macro
    Rows("78:78").Select
    Selection.ClearContents

'ne pas protéger les cellules du THPE
    Sheets(Array("Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Decembre")).Select
    Sheets("Janvier").Range("U6:V36").Locked = False
    Range("U6:V36").FormulaHidden = True

'remettre protection des mois
    Sheets("Janvier").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Fevrier").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Mars").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Avril").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Mai").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Juin").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Juillet").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Aout").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Septembre").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Octobre").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Novembre").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

    Sheets("Decembre").Select
    ActiveSheet.Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:= _
        False

Application.ScreenUpdating = True

'afficher la feuille du mois de la saisie
   Sheets("Formulaire").Select
   Range("F1:G1").Select
   Application.Goto

          Exit Sub

'On Error GoTo 0

End Sub

le problème vient de la fin du code.

Et j'aimerai que la feuille qui s'affiche à la fin du code soit la destination de la recherche dans le code extrait ci-dessous

        Destination:=FL1.Cells(NoLig, 2)

MERCI BEAUCOUP si vous pouvez m'aider

(mon fichier est plein de code VBA, formules, mise en forme conditionnel, validation de donnée, etc... et je suis certaine que j'ai beaucoup de chose à améliorer mais j'ai peur que trop de changement et que ce soit moi qui serais perdue si un problème survient et que je doive le corriger... c'est un fichier utiliser par 850 à 1000 personnes au minimum et que je dois gérer durant l'année en cas de problème. Mais si un expert en vba veut y jeter un coup d'oeil et me donner de bon conseil c'est volontiers que je trouve le moyen de le transmettre. Ce fichier me met une grosse pression... )

Le 27/10/2021 à 16:50

Bonjour,

Le problème C'est que votre Feuille FL1 est une boucle de valeur i : FL1 = Worksheets(Worksheets(i).Name)

Il faut donc noter dans la boucle quand la feuille est trouvée le nom pour s'y rendre à la fin.

For i = 6 To 22 'feuilles
Set FL1 = Worksheets(Worksheets(i).Name)
   For NoLig = 2 To 37 'colonne B
        Var = FL1.Cells(NoLig, NoCol)
        If Var = Cherche Then
        Worksheets("Saisies").Range("B2:V2").Copy _
        Destination:=FL1.Cells(NoLig, 2)
Mafeuille=Worksheets(Worksheets(i).Name
        End If
    Next

'Et à la fin 
Worksheets(Mafeuille).activate
Le 27/10/2021 à 17:11

Bonjour Noemi, Xmenpl

Pour commencer, on peut supprimer tous les "Select" qui font perdre du temps au code
Ensuite on peut ajouter des boucles pours les lignes à effacer
On pourrait optimiser encore le code pour les pages à effacer (à voir)

Voici ce que ça peut donner (à peu prêt) car sans fichier, c'est compliqué

Option Explicit

Sub EnvoyerSaisieMois()
  Dim Ind As Integer, Lig As Long
  Dim TabMois() As String
  Dim ShtS As Worksheet
  Dim MaFeuille As String
  ' Définir le tableau des mois
  TabMois = Split("Janvier,Fevrier,Mars,Avril,Mai,Juin,Juillet,Aout,Septembre,Octobre,Novembre,Decembre,Saisies", ",")
  'On Error Resume Next
  Application.ScreenUpdating = False
  ' Pour chaque feuille
  For Ind = 0 To 12
    'enlever protection feuilles des mois
    Sheets(TabMois(Ind)).Unprotect "test"
  Next Ind
  ' Définir la feuille de saisie
  Set ShtS = Sheets("Saisies")
  'créer une nouvelle ligne
  ShtS.ListObjects(1).ListRows.Add 1
  'remplir le tableau saisie
  Sheets("Formulaire").Range("A78:X78").Copy
  ShtS.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  Dim i As Integer
  Dim FL1 As Worksheet, NoCol As Integer
  Dim NoLig As Long, Var As Variant, Cherche
  Cherche = ShtS.Range("B2").Value
  NoCol = 2                                      'lecture de la colonne B
  For i = 6 To 22                                'feuilles
    Set FL1 = Worksheets(Worksheets(i).Name)
    For NoLig = 2 To 37                          'colonne B
      Var = FL1.Cells(NoLig, NoCol)
      If Var = Cherche Then
        ShtS.Range("B2:V2").Copy Destination:=FL1.Cells(NoLig, 2)
        MaFeuille = FL1.Name
      End If
    Next
  Next

  'proteger feuille
  ActiveSheet.Protect "test", DrawingObjects:=True, Contents:=True, Scenarios:=True

  'masquer les lignes
  With Sheets("Formulaire")
    .Rows("9:1000").Hidden = True
    'afficher les lignes des catégories
    .Rows("1:8").Hidden = False
    'explications
    .Range("A9:K11").ClearContents
    'affichage de la catégorie
    .Range("I1:L1").ClearContents
    .Range("B12,D12,F12,H12,J12?l12,L16").FormulaR1C1 = "=R[4]C"
    .Range("A15:C15,D15").ClearContents
    .Range("A18").ClearContents
    .Range("F21:I21").ClearContents
    For Lig = 23 To 55 Step 2
      .Range("A" & Lig & ":C" & Lig).ClearContents
    Next Lig
    .Range("C57,E59,K59,E62").ClearContents
    .Range("F57:I57").ClearContents
    .Range("A72:N72").ClearContents
    .Range("I26,I36,I38,I42").ClearContents
    .Range("R81").ClearContents
    .Range("I65:K66").ClearContents
    .Range("N23,N25").ClearContent
    .Range("H65:N65").ClearContents
    .Range("L66:M66").ClearContents
    .Range("N27,N29,N37,N39,N33,N43,N47,N49").ClearContents
    .Range("K40:L40").ClearContents
    .Range("K44:L44").ClearContents
    .Range("I50:J50").ClearContents
    .Range("I52:J52").ClearContents
    .Range("I54:J54").ClearContents
    With .Range("I50:J50").Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 13619151
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
    With .Range("I52:J52").Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 13619151
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With

    With .Range("I54:J54").Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 13619151
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
    ' EffacerContenuTableau Macro
    .Rows("78:78").ClearContents
  End With
  'ne pas protéger les cellules du THPE
  Sheets(Array("Janvier", "Fevrier", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Decembre")).Select
  Sheets("Janvier").Range("U6:V36").Locked = False
  Range("U6:V36").FormulaHidden = True
  'remettre protection des mois
  For Ind = 1 To 13
    Sheets(TabMois(Ind)).Protect "test", DrawingObjects:=False, Contents:=True, Scenarios:=False
  Next Ind
  ' Aller à la feuille de la boucle
  Sheets(MaFeuille).Activate
  '
  Application.ScreenUpdating = True
End Sub

@+

Le 28/10/2021 à 09:28

merci pour les conseils !

Je vais essayer de comprendre les modifications que vous me proposez pour le code. Tout ce que j'aurai compris je le modifierai. L'entreprise pour laquelle je travaille sont encore sous MS OFFICE 2013 j'espère que tout fonctionnera...

le fichier est trop lourd pour que je le transmette ici....... je peux le transmettre d'une autre façon si vous voulez y jeter un coup d'oeil ???

MERCI beaucoup

Le 28/10/2021 à 09:40

XmenPL, ça ne fonctionne pas...

image
Le 28/10/2021 à 11:46

Oops FL1 c'est déjà le nom de feuille --->

Mafeuille=FL1

Le 28/10/2021 à 16:34

XmenPL, ça ne m'amène pas au mois trouvé mais au dernier mois celui de décembre

Le 29/10/2021 à 11:15

Bizarre si var=cherche alors Mafeuille=FL1 sinon Mafeuille ne doit pas changer.

Vous avez bien inséré la ligne Mafeuille=FL1 avant le end if ?

Sinon il faut peut-être sortir de la boucle quand Var=cherche ?

Rechercher des sujets similaires à "application goto"