Microsoft 365 Tri et Import

Le Rouky

XLDnaute Nouveau
Le Forum,

Je n'arrive pas copier une plage de donnée selon un critère et l'importer dans un tableau contenant des cellules fusionnées.
il faudrait :
Lors de l'appui sur le bouton "New Sem" de la feuille "Sem 13" du fichier "Import",
prendre certaines données marquées d'une croix dans la colonne intitulé "13" puis les reporter dans le tableau feuille "Master" du fichier "Essai".

Cordialement
 

Pièces jointes

  • Essai.xlsm
    18.6 KB · Affichages: 5
  • Import.xlsm
    16.3 KB · Affichages: 4
Solution
Bonjour,
J'ai retesté, sur mon PC ça marche. Voir ci dessous.
1- Avez vous accepté les macros ?
2- Le nom du fichier et le nom de la feuille sont ils corrects ?
En PJ la même macro mais avec 3 sécurités :
1- Fichier inexistant
2- Feuille inexistante
3- Semaine inexistante

Test4.gif

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Le Rouky,
Un essai en PJ.
1- Les deux fichiers sont stockés dans le même répertoire.
2- L'exécution est automatique lorsqu'on modifie le N° de semaine ( B1 ), avec :
VB:
Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [B1]) Is Nothing Then
        Dim NomFichier$, NomFeuille$, DL%, Wkb, N%, i%
        NomFichier = "Essai.xlsm"                                   ' A mettre à jour
        NomFeuille = "Master"                                       ' A mettre à jour
        Application.ScreenUpdating = False
        Set Wkb = GetObject(ThisWorkbook.Path & "\" & NomFichier)   ' Accès fichiet
        Tablo = Wkb.Sheets(NomFeuille).[A1].CurrentRegion           ' Tranfert données dans Tablo
        For i = 11 To UBound(Tablo, 2)                              ' Recherche de la colonne qui correspond à la semaine
            If Tablo(2, i) = Target Then Colonne = i: Exit For
        Next i
        If i = 1 + UBound(Tablo, 2) Then Exit Sub                   ' Semaine non trouvée
        [A4:D255].ClearContents                                     ' Effacement feuille
        N = 0
        For i = 3 To UBound(Tablo)                                  ' Pour toutes les lignes
            If Tablo(i, Colonne) = "x" Then                         ' Si la semaine est correcte
                N = N + 1: Ligne = 2 * N + 2                        ' Calcul du N° de ligne où écrire
                Cells(Ligne, "A") = Tablo(i, 2) ' Nom               ' Transfert données.
                Cells(Ligne, "B") = Tablo(i, 3) ' Prénom
                Cells(Ligne, "C") = Tablo(i, 1) ' Ref
                Cells(Ligne, "D") = Tablo(i, 8) ' Tel
            End If
        Next i
    End If
Fin:
End Sub
 

Pièces jointes

  • Import.xlsm
    28.5 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
J'ai retesté, sur mon PC ça marche. Voir ci dessous.
1- Avez vous accepté les macros ?
2- Le nom du fichier et le nom de la feuille sont ils corrects ?
En PJ la même macro mais avec 3 sécurités :
1- Fichier inexistant
2- Feuille inexistante
3- Semaine inexistante

Test4.gif
 

Pièces jointes

  • Import V2.xlsm
    30.1 KB · Affichages: 4

Discussions similaires

Réponses
9
Affichages
506

Statistiques des forums

Discussions
312 211
Messages
2 086 299
Membres
103 172
dernier inscrit
Aurelyan