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

 

[jeje77]

Je viens d'essayer ce nouveau code effectivement avec 'ActiveWorkbook' au lieu de 'ThisWorkbook' ça ne bug plus à la ligne 'WbSource.Sheets("Cal." &...' . Ça déroule jusqu'au bout mais il n'y a que les données de la 1ere colonne qui sont inscrite les autres sont vierges et ça prend le format des cellules sources.

 

[vgendron]

ca donnerait ceci :: utilisation d'un tableau plutot que array

Sub Copie_01()
Dim WbSource, WbDestination As Workbook
Dim ListeAgent() As Variant 'déclaration d'un tableau
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")
ListeAgent = WbSource.Sheets("ACCUEIL").Range("X15:X20").Value
   
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

For i = LBound(ListeAgent, 1) To UBound(ListeAgent, 1)
    WbDestination.Sheets("janv_4").Cells(2, i + 1) = ListeAgent(i, 1)
    WbSource.Sheets(ListeAgent(i, 1)).Range("jan_" & i).Copy Destination:=WbDestination.Sheets("janv_4").Cells(3, i + 1)
Next i
End Sub

 

[vgendron]

Tu peux aussi utiliser une zone nommée ListeAgents dans ta feuille Accueil
voir PJ avec les trois solutions

 

[jeje77]

Je viens de comprendre pourquoi je n'ai que la première colonne qui est bien copiée.
En fait ça me recopie les formules des cellules avec un un lien vers la feuille de départ et donc a chaque boucle la formule est décalée d'une colonne.
Je pense que de copier et coller que les valeurs sans le format des cellules sources serait beaucoup mieux et certainement moins lourd pour le fichier.

 

[jeje77]

J'ai testé les 3 macros du dernier fichier que vous avez renvoyé la première macro va bien mais la 2eme et la 3eme modifie les valeurs de la ligne 2 des noms.
Je pense que changer le 2 en 3 devrait faire l'affaire dans '...Cells(3,i+1)=....'
WbDestination.Sheets("janv_4").Cells(2, i + 1) = ListeAgent(i, 1)

 

[vgendron]

2eme et la 3eme modifie les valeurs de la ligne 2 des noms.

effectivement, j'ai juste ajouté une ligne de code dans la boucle pour mettre le nom de l'agent au dessus des data copiées. c'était juste pour un essai
tu peux supprimer cette ligne ou la mettre en commentaire

WbDestination.Sheets("janv_4").Cells(2, i + 1) = ListeAgent(i, 1)

 

[jeje77]

Est-il possible de ne coller uniquement que les valeurs des cellules sans le format des cellules source en intégrant dans le code une ligne de ce style :

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

J'essaye de l’intégrer pour n'avoir que les valeurs des cellules mais je ne trouve pas ou l’insérer.

 

[vgendron]

sans sélection (sinon bug au cas ou c'est pas la bonne feuille qui est active)

Sub Copie_03() 'avec une zone nommée directement dans la feuille ACCUEIL
Dim WbSource, WbDestination As Workbook
Dim agent
Dim i As Integer

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
   
Workbooks.Open Filename:="C:\Users\Jerome\Desktop\gestion Absences ANTIN.xlsm"
Set WbDestination = ActiveWorkbook 'celui qui vient d'etre ouvert

i = 1
For Each agent In WbSource.Sheets("ACCUEIL").Range("ListeAgents")
    'WbDestination.Sheets("janv_4").Cells(2, i + 1) = agent
    WbSource.Sheets("" & agent & "").Range("jan_" & i).Copy
    WbDestination.Sheets("janv_4").Cells(3, i + 1).PasteSpecial xlPasteValues
    i = i + 1
Next agent
End Sub

 

[jeje77]

Oups !!!
Décidément il faut que je m’améliore dans la saisie j'ai un temps de retard. La réponse est déjà arrivée

 

[jeje77]

Un grand merci ça fonctionne très bien j'ai nommé une zone 'ListeAgents' sur la feuille 'ACCUEIL' et aucun problèmes. Ça tourne rond.
Je vais faire la même chose pour les mois suivant.

Merci encore pour votre aide vgendron

Cordialement
Jérôme

 

[vgendron]

j'ai nommé une zone 'ListeAgents'

normalement, c'était déjà le cas.
déclarée dynamiquement (càd s'adapte automatiquement au nombre de noms saisis)
ouvrir le gestionnaire de noms pour la voir

 

[jeje77]

Voila les macros adaptées à mes fichiers.

 

[vgendron]

Hello
une amélioration pour ta fonction Copie_Mois

Sub Copie_Mois() 'avec une zone nommée directement dans la feuille ACCUEIL

Dim WbSource, WbDestination As Workbook
Dim agent
Dim i As Integer

Application.ScreenUpdating = False
Set WbSource = ActiveWorkbook   'Fichier actif c'est celui qui sert de source
                                'et qui contient les différents onglets listés ci dessous

Workbooks.Open Filename:="C:\Users\Jerome\Desktop\Gestion Absences ANTIN.xlsm"
Set WbDestination = ActiveWorkbook 'celui qui vient d'etre ouvert

i = 1
For Each agent In WbSource.Sheets("ACCUEIL").Range("ListeAgents")
   
    WbSource.Sheets("" & agent & "").Range("jan_" & i).Copy
    WbDestination.Sheets("janv_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Fev_" & i).Copy
    WbDestination.Sheets("Fev_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Mars_" & i).Copy
    WbDestination.Sheets("Mar_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Avr_" & i).Copy
    WbDestination.Sheets("Avr_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Mai_" & i).Copy
    WbDestination.Sheets("Mai_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Juin_" & i).Copy
    WbDestination.Sheets("Juin_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Juil_" & i).Copy
    WbDestination.Sheets("Juil_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Aout_" & i).Copy
    WbDestination.Sheets("Aou_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Sept_" & i).Copy
    WbDestination.Sheets("Sept_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Oct_" & i).Copy
    WbDestination.Sheets("Oct_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Nov_" & i).Copy
    WbDestination.Sheets("Nov_4").Cells(3, i + 1).PasteSpecial xlPasteValues
   
    WbSource.Sheets("" & agent & "").Range("Dec_" & i).Copy
    WbDestination.Sheets("Dec_4").Cells(3, i + 1).PasteSpecial xlPasteValues
       
    i = i + 1
Next agent

Sheets(Array("janv_4", "Fev_4", "mar_4", "avr_4", "mai_4", "juin_4", "juil_4", "aou_4" _
, "sept_4", "oct_4", "nov_4", "dec_4")).Select
Sheets("janv_4").Activate
Range("B3").Select
Sheets("janv_4").Select
       
Application.ScreenUpdating = True
End Sub

ce sera plus rapide

 

[vgendron]

autre chose pour l'ouverture du second fichier Destination
si le nom du fichier change, tu peux remplacer cette ligne

Workbooks.Open Filename:="C:\Users\Jerome\Desktop\test selection cells 02.xlsm"
Set WbDestination = ActiveWorkbook 'celui qui vient d'etre ouvert

par celles ci

Filename = Application.GetOpenFilename
If Filename <> "" Then
    Workbooks.Open Filename
End If

Set WbDestination = ActiveWorkbook 'celui qui vient d'etre ouvert

 

[vgendron]

Quant au code pour effacer les V1 et V2
tu peux le modifier ainsi pour supprimer les V1 et V2 de TOUTES les feuilles en une fois

Sub Test()

Dim zone() As Variant 'définition d'un tableau
Dim i, j  As Integer
Dim Ws As Worksheet

For Each Ws In Worksheets
    zone = Ws.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
   
    Ws.Range("B3:G36") = zone 'on recopie le tableau
Next Ws
End Sub