Macro qui ne s applique pas aux onglets selectionnés

Résolu
CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention   -  
CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'ai mis en place une macro, je souhaite qu'elle s'applique à plusieurs onglet helas
ça ne fonctionne pas et je ne comprends pas pourquoi.

J'ai déjà utilise plusieurs types de code trouvés sur la toile.

Voici le code 
Sub Copier_Col()

Dim ws As Worksheet
Mois = Range("P8").Value

For Each ws In Worksheets
If ws.Name <> "Feuil1" Or ws.Name <> "Feuil2" Then

If Mois = "Jan" Then
    
Range("P9:P595").Select
selection.Copy
Range("BA9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If

If Mois = "Feb" Then
    
Range("P9:P595").Select
selection.Copy
Range("BB9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Mar" Then
    
Range("P9:P595").Select
selection.Copy
Range("BC9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Apr" Then
    
Range("P9:P595").Select
selection.Copy
Range("BD9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "May" Then
    
Range("P9:P595").Select
selection.Copy
Range("BE9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Jun" Then
    
Range("P9:P595").Select
selection.Copy
Range("BF9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Jul" Then
    
Range("P9:P595").Select
selection.Copy
Range("BG9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Aug" Then
    
Range("P9:P595").Select
selection.Copy
Range("BH9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Sep" Then
    
Range("P9:P595").Select
selection.Copy
Range("BI9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Oct" Then
    
Range("P9:P595").Select
selection.Copy
Range("BJ9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Nov" Then
    
Range("P9:P595").Select
selection.Copy
Range("BK9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

If Mois = "Dec" Then
    
Range("P9:P595").Select
selection.Copy
Range("BL9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If



End If
Next
End Sub


Par avance merci de votre aide

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici :ICI

Merci d'y penser dans tes prochains messages.

3 réponses

  1.
    jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830
     
    Bonjour,

    Déjà.. tu as un souci sur ton IF 
    If ws.Name <> "Feuil1" Or ws.Name <> "Feuil2" Then

    En gros si la feuille n'est pas Feuil1 ..... ou Feuil2 ... (donc si je suis la feuille1.. je ne suis pas la deux.. et inversement....)......

    A mon avis ... il faudrait un AND à la place du OR. 
    If ws.Name <> "Feuil1" AND ws.Name <> "Feuil2" Then


    Ensuite... à mon avis... ceci 
    Mois = Range("P8").Value

    Devrait se trouver DANS ta boucle....

    Penses également à préfixer les RANGE(...) ... par la FEUILLE sur laquelle doit s'appliquer la "selection".

    Par exemple : 
    Ws.Range("P9:P595").Select
selection.Copy
Sheets("Feuil1").Range("BA9").Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


    Bon .. après... je ne sais pas ce que tu veux réellement faire avec ta macro... et il est conseillé d'éviter de faire des copier/coller ....
    Par exemple tu pourrais, si mes souvenirs sont bons, remplacer le code ci-dessus par : 
      Sheets("Feuil1").Range("BA9:BA595").value = Ws.Range("P9:P595").value


    Cordialement, 
    Jordane                                                                 
    0
    1. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830
       
      Par exemple, regardes ce que donne la macro suivante : 
      Sub test()
Dim F1 As Worksheet
Dim F2 As Worksheet

Set F1 = Sheets(1)  'Feuil1
Set F2 = Sheets(2) 'Feuil2

'Copie des valeurs de la feuille 2 vers la feuille 1
F1.Range("A1:A10").Value = F2.Range("A1:A10").Value

End Sub
      0
      1. CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention   1 > jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention  
         
        Bonsoir et merci,

        Malheureusement je ne trouve pas de solution,

        je souhaite coller la colonne P

        en BA pour janvier
        en BB pour février
        en BC pour mars ....

        Le mois est en P8

        Je veux le faire pour l ensemble des feuilles du classeur sauf 4 ou 5.

        La boucle ne fonctionne pas même avec une manipulation plus simple

        Je continue de chercher et vous tiens au courant !

        Encore merci pour le coup de main
        0
  2. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830
     

    je souhaite coller la colonne P

    en BA pour janvier
    en BB pour février
    en BC pour mars ....

    Le mois est en P8

    La colonne P de quelle feuille ?
    Coller en BA BB BC... de quelle feuille ?
    Le mois est en P8 ..... dans QUELLE FEUILLE ???

    Avant de parler de boucle... commence par nous expliquer EXACTEMENT comment doit fonctionner ta macro (en précisant ce que viennent faire les différents onglets ! )

    Tu peux également (donc en plus de l'explication demandée ci-dessus...) nous mettre un fichier Exemple à disposition via le site : cijoint.com par exemple.
    https://www.commentcamarche.net/faq/29493-utiliser-cjoint-pour-heberger-des-fichiers

    0
    1. CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention   1
       
      Bonsoir,

      j'ai mis un exemple d onglet sous le chemin suivant :

      http://www.cjoint.com/c/FBxwCxyzVgP

      En fait j ai une trentaine d onglets dans ce style, et 2 ou 3 qui sont des consolidations.

      J aimerais que chaque mois et que pour chacun des onglet de ce type

      la colonne P soit Copier Coller valeur en BA, puis en BB le mois suivant ....

      le fait de coller la colonne P chaque mois me permettra d avoir un historique sur la même page et de déterminer la consommation mensuelle .

      merci de ton aide
      0
    2. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830
       
      Essayes ça : 
      Sub test()
Dim sh As Worksheet
Dim valCelP8 As String
Dim ColCopie As Long
Dim RngToSave As Range
Dim RngSource As Range

For Each sh In ThisWorkbook.Worksheets
  sh.Activate
  If sh.Name <> "Feuil1" And sh.Name <> "Feuil2" Then
      'Plage de cellules à sauvegardes
      Set RngSource = sh.Range("P9:P595")
      
      'Valeur de la cellule P8
      valCelP8 = sh.Range("P8").Value
      
      'On regarde dans quel cas on se trouve :
      Select Case valCelP8
        
        Case "Jan"
          ColCopie = 53 'Ba
        Case "Fev"
          ColCopie = 54 'Bb
        Case Else
         Debug.Print "Feuille : " & sh.Name & "-> Valeur inconnue"
         Resume Next
      End Select
        
    'On définie la plage où sauvegarder
    Set RngToSave = sh.Range(Cells(9, ColCopie), Cells(595, ColCopie))
    
    'Sauvegarde des valeurs
    Debug.Print "Feuille : " & sh.Name & "-> Copie des valeurs dans la colonne " & ColCopie
    RngSource.Copy Destination:=RngToSave
  End If

Next


End Sub
      0
    3. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830 > jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention  
       
      Bien entendu.. il faut compléter le SELECT CASE avec les autres mois..
      0
    4. CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention   1 > jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention  
       
      Bonjour Jordane45,

      Le copier coller ne s effectue toujours pas.
      J avais un problème sur Resume next il fallait noter On error Resume next.

      Quand je décompose la macro en F8 elle passe bien sur l ensemble des feuilles.

      Par contre sur cette ligne:

      RngSource.Copy Destination:=RngToSave

      Quelque soit la page le Rngtosave = Noting.

      En tout cas merci de ton aide
      0
    5. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830 > CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention  
       
      Tu peux me montrer le code modifié ?
      Tu as bien complété le SELECT CASE ?
      Quand tu es en mode pas à pas (F8) que vaut la variable ColCopie ?
      0
  3. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830
     
    1 - **** Attention ****
    Merci de bien vouloir utiliser la coloration syntaxique (les balises de code) lorsque tu postes du code sur le forum.
    Explications disponibles ici :
    https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

    2 - Essayes ce code : 
    Sub test()
Dim sh As Worksheet
Dim valCelP8 As String
Dim ColCopie As Long
Dim RngToSave As Range
Dim RngSource As Range

For Each sh In ThisWorkbook.Worksheets
  sh.Activate
  If sh.Name <> "Feuil1" And sh.Name <> "Feuil2" And sh.Name <> "Feuil3" And sh.Name <> "Feuil40" And sh.Name <> "Feuil41" And sh.Name <> "Feuil68" And sh.Name <> "Feuil71" And sh.Name <> "Feuil75" And sh.Name <> "Feuil86" Then
      'Plage de cellules à sauvegardes
      Set RngSource = sh.Range("P9:P595")
      
      
      'Valeur de la cellule P8
      valCelP8 = sh.Range("P8").Value
      
      'On regarde dans quel cas on se trouve :
      Select Case valCelP8
       Case "Jan"
        ColCopie = 53 'Ba
       Case "Fev"
        ColCopie = 54 'Bb
       Case "Mar"
        ColCopie = 55 'Bc
       Case "Apr"
        ColCopie = 56 'Bd
       Case "May"
        ColCopie = 57 'Be
       Case "Jun"
        ColCopie = 58 'Bf
       Case "Jul"
        ColCopie = 59 'Ba
       Case "Aug"
        ColCopie = 60 'Bb
       Case "Sep"
        ColCopie = 61 'Bc
       Case "Oct"
        ColCopie = 62 'Bd
       Case "Nov"
        ColCopie = 63 'Be
       Case "Dec"
        ColCopie = 64 'Bf
       Case Else
         Debug.Print "Feuille : " & sh.Name & "-> Valeur inconnue"
         ColCopie = 0
      End Select
        
    If ColCopie <> 0 Then
        'On définie la plage où sauvegarder
        Set RngToSave = sh.Range(Cells(9, ColCopie), Cells(595, ColCopie))
    
        'Sauvegarde des valeurs
        Debug.Print "Feuille : " & sh.Name & "-> Copie des valeurs dans la colonne " & ColCopie
        RngSource.Copy Destination:=RngToSave
    Else
        Debug.Print "Feuille : " & sh.Name & " -> ColCopie =" & ColCopie & " /!\  Aucune valeur ne correspond : " & valCelP8
    End If
  End If


Next


End Sub

    et dis moi ce que ça te mets dans la fenêtre d'exécution.
    Vérifies également le contenu de la variable : valCelP8 ... est-ce que tu y retrouves les différents mois tels que décris dans le SELECT CASE ?
    0
    1. CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention   1
       
      Le blocage venait effectivement de la description des mois,

      j'ai rectifié ça fonctionne,

      mon seul et dernier problème c'est que la colonne P n'est pas copiée en valeur,
      donc pour chaque onglet ça me demande si il doit rafraichir les liens et en plus ça risque de fausser le résultat.

      merci beaucoup en tout cas
      0
    2. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830 > CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention  
       
      Si tu veux copier uniquement les valeurs
      essayes ça : 
      ' A la place de :  RngSource.Copy Destination:=RngToSave
' mettre :
RngSource.Copy
RngToSave.PasteSpecial xlPasteValues
      0
    3. CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention   1 > jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention  
       
      Un grand merci à toi jordane45,

      ça fonctionne super bien maintenant.
      Je n'aurais jamais réussi sans toi !

      Le vba je manipule un peu, je copie, je modifie mais je n arrive pas à realiser une programmation.

      Merci beaucoup pour ton aide
      bonne journée
      0
    4. CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention   1 > jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention  
       
      Bonjour,

      après vérification cette partie ne fonctionne pas.
      La macro s’exécute pour toutes les feuilles.

      Je ne comprends pas pourquoi.
      0
    5. jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830 > CHARLYJACK Messages postés 345 Date d'inscription   Statut Membre Dernière intervention  
       
      Quelle partie ??
      Quelles feuilles ne devraient pas avoir cette macro ??
      Merci d'être plus précis.
      0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses
Comment supprimer les onglets?
VictimeDeLinformatique -
VictimeDeLinformatique -

2 réponses