XL 2010 Selectionner certaines cellules dans un tableau

[jeje77]

Bonjour à tous;
je reviens vers vous car je n'arrive pas à trouver dans les différents posts comment sélectionner les cellules ayant les valeurs V1 et V2 dans mon tableau au moyen d'un code VBA afin de pouvoir les effacer toutes en même temps. Ce sont des données que j'ai importé d'un autre classeur par le biais d'une macro, mais avec cette macro je copie toutes les cellules même celle dont je n'ai pas besoin et donc après il faut que je les effacent individuellement sur chaque feuilles (qui ont la même architecture).
Le tableau se situe de B3:G36.
D'avance merci pour l’intérêt que vous porterez à mon problème.
Jeje77

 

[vgendron]

Bonjour,
pas facile de t'aider avec une image..
mais l'idée est la suivante
set Zone=range("A150") ' tout le tableau qui contient des données à effacer
for each valeur in zone
if valeur="V1" or valeur="V2" then
valeur=""
end if
next valeur

 

[jeje77]

Je vous fait parvenir un exemple du fichier.
Rien ne se passe à la fin de la macro, j'ai essayer de déclarer des variables mais à l'arrivée je n'ai pas de cellules sélectionnées et je ne sait pas ou insérer un "range.select" si toute fois c'est cela qu'il me manque.

 

[gosselien]

Bonjour,

Set zone = Range("B3:G36 ") <---- espace après le G36

P.

 

[jeje77]

J'ai bien l'espace comme indiqué mais rien à faire ça veut pas

 

[jeje77]

Je pense avoir trouvé la solution
Le code:

Sub Test()

Dim zone As Range, V1 As String, V2 As String, valeur As Variant

Set zone = Range("B3:G36 ") ' tout le tableau qui contient des données à effacer"

  For Each valeur In zone

  If valeur = "V1" Or valeur = "V2" Then
 
  valeur.ClearContents
 
  End If

  Next valeur


End Sub

 

[vgendron]

avec ce code,
c'est plus rapide

Sub Test()

Dim zone() As Variant 'définition d'un tableau
Dim i, j  As Integer
zone = Range("B3:G36").Value ' tout le tableau qui contient des données à effacer"

    For i = LBound(zone, 1) To UBound(zone, 1) 'pour chaque ligne du tableau
        For j = LBound(zone, 2) To UBound(zone, 2) 'pour chaque colonne
            If zone(i, j) = "V1" Or zone(i, j) = "V2" Then 'on efface
                zone(i, j) = ""
            End If
        Next j
    Next i
   
    Range("B3:G36") = zone 'on recopie le tableau

End Sub

 

[jeje77]

Sub Copie_01()
'
' Copie_01 Macro
'

'
    Workbooks.Open Filename:= _
        "C:\Users\Jerome\Desktop\gestion Absences ANTIN.xlsm"
       
'''''''''' Recopie gardes 1er Agent ''''''''''''
       
    Windows("Gardes UT4 2018 - Copie.xlsm").Activate
    Sheets("cal.LAGARDE").Range("jan_1").Copy              '.Select
    'Range("jan_1").Select
    'Selection.Copy
    Range("A1").Select
   
    Windows("gestion Absences ANTIN.xlsm").Activate
    Sheets("janv_4").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
'''''''''' Recopie gardes 2eme Agent ''''''''''''
   
    Windows("Gardes UT4 2018 - Copie.xlsm").Activate
    Sheets("cal.ROLET").Range("jan_2").Copy              '.Select
    'Range("jan_2").Select
    'Selection.Copy
    Range("a1").Select
   
    Windows("gestion Absences ANTIN.xlsm").Activate
    Sheets("janv_4").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
'''''''''' Recopie gardes 3eme Agent ''''''''''''
   
    Windows("Gardes UT4 2018 - Copie.xlsm").Activate
    Sheets("cal.BOUTEL").Range("jan_3").Copy                '.Select
    'Range("jan_3").Select
    'Selection.Copy
    Range("a1").Select
   
    Windows("gestion Absences ANTIN.xlsm").Activate
    Sheets("janv_4").Select
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
'''''''''' Recopie gardes 4eme Agent ''''''''''''
   
    Windows("Gardes UT4 2018 - Copie.xlsm").Activate
    Sheets("cal.CHARLETTINE").Range("jan_4").Copy          '.Select
    'Range("jan_4").Select
    'Selection.Copy
    Range("a1").Select
   
    Windows("gestion Absences ANTIN.xlsm").Activate
    Sheets("janv_4").Select
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
   
'''''''''' Recopie gardes 5eme Agent ''''''''''''
   
    Windows("Gardes UT4 2018 - Copie.xlsm").Activate
    Sheets("cal.PERETTI").Range("jan_5").Copy               '.Select
    'Range("jan_5").Select
    'Selection.Copy
    Range("a1").Select
   
    Windows("gestion Absences ANTIN.xlsm").Activate
    Sheets("janv_4").Select
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
   
'''''''''' Recopie gardes 6eme Agent ''''''''''''
   
    Windows("Gardes UT4 2018 - Copie.xlsm").Activate
    Sheets("cal.MELINE").Range("jan_6").Copy                '.Select
    'Range("jan_6").Select
    'Selection.Copy
    Range("a1").Select
   
    Windows("gestion Absences ANTIN.xlsm").Activate
    Sheets("janv_4").Select
    Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("B3").Select
End Sub

Merci beaucoup !!!
Ce code est on ne peut plus rapide.
je vais abuser de vos compétences, mais le code que j'ai fait avec Excel pour copier mes données vers mon classeur, je me perds entre les workbooks et les Sheets et je reviens toujours à sélectionner le classeur et ensuite la feuille pour récupérer les données et je trouve que ça rame énormément.
Vu la longueur du code y aurait il une solution moins longue pour éviter les aller et retour sur les feuilles.

Encore grand merci

 

[vgendron]

Hello
Sans tes fichiers pour tester... je ne garanti rien
un essai

Sub Copie_01()
Dim WbSource, WbDestination As Workbook
Dim ListeAgent
Dim agent As String
Dim i As Integer
' Copie_01 Macro
'

Set WbSource = ActiveWorkbook 'suppose que le fichier actif est celui qui sert de source et qui contient les différents onglets listés ci dessous
ListeAgent = Array("LAGARDE", "ROLET", "BOUTEL", "CHARLETTINE", "PERETTI", "MELINE")
   
Workbooks.Open Filename:="C:\Users\Jerome\Desktop\gestion Absences ANTIN.xlsm"
Set WbDestination = ThisWorkbook

'''''''''' Recopie gardes des agents ''''''''''''
For i = 0 To 5 '  = pour chaque agent de ListeAgent
    'MsgBox ListeAgent(i)
    WbSource.Sheets("Cal." & ListeAgent(i)).Range("jan_" & i + 1).Copy Destination:=WbDestination.Sheets("janv_4").Cells(3, i + 2)
Next i
End Sub

 

[jeje77]

Bonjour vgendron,
Merci pour la réponse effectivement c'est beaucoup moins long comme code.
Je vais essayer de voir ce que ça donne et de l'adapter aux fichiers

 

[jeje77]

je confirme que le fichier -Gardes UT4 2018- est le fichier actif qui sert de source pour récupérer les données des agents.
Chaque agent à un calendrier avec le report de ses repos et autres... et chaque feuilles des agents sont nommées 'cal.(nom_agent)'

Je viens de tester le code mais ça bloque sur cette ligne:

    WbSource.Sheets("Cal." & ListeAgent(i)).Range("jan_" & i + 1).Copy Destination:=WbDestination.Sheets("janv_4").Cells(3, i + 2)

avec un message : Erreur d’exécution '9', l'indice n'appartient pas à la sélection.

    ListeAgent = Array("LAGARDE", "ROLET", "BOUTEL", "CHARLETTINE", "PERETTI", "MELINE")

Sur cette ligne ci-dessus, est-ce que ARRAY, récapitule les onglets des agents ?

Si oui pourquoi ne pas mettre le 'cal.' dans cette énumération.
Je pose ces question car je cherche à comprendre le code qui bloque sur la boucle au premier nom.
Je vais essayer d'extraire les feuilles pour vous envoyer un exemple du fichier.
Peut etre que cela servira à d'autres personnes

cordialement
Jérôme

 

[jeje77]

voici le morceau du fichier si ça peut aider ...

 

[vgendron]

essaie avec ceci. légèrement modifié

Sub Copie_01()
Dim WbSource, WbDestination As Workbook
Dim ListeAgent
Dim agent As String
Dim i As Integer
' Copie_01 Macro
'

Set WbSource = ActiveWorkbook 'suppose que le fichier actif est celui qui sert de source et qui contient les différents onglets listés ci dessous
ListeAgent = Array("LAGARDE", "ROLET", "BOUTEL", "CHARLETTINE", "PERETTI", "MELINE")
   
Workbooks.Open Filename:="C:\Users\Jerome\Desktop\gestion Absences ANTIN.xlsm"
Set WbDestination = ActiveWorkbook 'celui qui vient d'etre ouvert

'''''''''' Recopie gardes des agents ''''''''''''
For i = 0 To 5 '  = pour chaque agent de ListeAgent
    'MsgBox ListeAgent(i)
    WbSource.Sheets("Cal." & ListeAgent(i)).Range("jan_" & i + 1).Copy Destination:=WbDestination.Sheets("janv_4").Cells(3, i + 2)
Next i
End Sub

Pour ListeAgent, effectivement, je pouvais mettre le .cal.. mais c'était plus long :-D

 

[jeje77]

Une autre petite question :
Le nom de mes onglets résultent d'une formule de concaténation sur la feuille 'ACCUEIL' cellule X15 à X20 pour prendre automatiquement le nom de l'agent si il y avait un changement.
Est-ce que cela pourrait éventuellement faire arrêter la macro à la ligne WbSource.Sheets("Cal." & ListeAgent(i))..... ?

 

[vgendron]

effectivement
la liste des agents est saisie en dur dans le code pour remplir le Array ListeAgents
et il n'y a aucun test au cas où la feuille n'existe pas..
maintenant. la liste des agents peut etre remplie d'une autre manière à partir de ta feuille "Accueil"