Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Transferts de deux pages dans une seule page.

Caninge

XLDnaute Accro
Bonjour à tous,

J'en appelle à vos compétences.
Il faudra probablement une macro pour transférer mais je ne sais pas faire (dommage j'aimerais tant)
Dans mon fichier il y a deux fichiers : BASE JEUDI ET LUNDI - DIMANCHE.
Je voudrais transférer les noms téléphones, jours, heures, villes et affectations dans un seul et même onglet : RESPONSABLES.
Les conditions sont : uniquement ceux qui ont un X dans la colonne A (jaune)
Les placer dans l'ordre alphabétique. Comme dans mon exemple.
C'est un peu compliqué !!!
Je ne sais pas.
Merci de se pencher sur la question.
CANINGE
 

Pièces jointes

  • Tâches des Responsables.xlsx
    18.2 KB · Affichages: 7

vgendron

XLDnaute Barbatruc
Bonjour

une suggestion pour commencer.. utilise l'enregistreur de macro
tu lances l'enregistrement
et tu fais à la main ce dont tu as besoin
1) appliquer un filtre sur la colonne A "Contient un "x"
2) copier coller le résultat du filtre dans la feuille qui va bien
3) appliquer un tri alpha
et arreter l'enregistrement de la macro

et voila. tu as ta première macro vba qu'il nous suffira d'optimiser
 

Caninge

XLDnaute Accro
Bonjour vgendron. Je connais l'enregistreur de macro. J'ai déjà fait mais des choses simples. La ça me paraît plus compliqué. Mais je vais essayé quand même. Je te tiens au courant. Demain car je ne suis pas chez moi. Bonne soirée. Merci.
 

Caninge

XLDnaute Accro
Bonjour

J'ai essayé c'est pas trop mal.
J'ai essayé avec la feuille BASE JEUDI AU LUNDI et le transfert vers RESPONSABLE_2
Si je prends Didier il manque 5 autres lignes qui lui correspondent.
Ce n'est pas trop la disposition que je veux mais bon c'est un bon début.
 

Pièces jointes

  • Tâches des Responsables_Essai_V3.xlsm
    31.8 KB · Affichages: 4

vgendron

XLDnaute Barbatruc
Hello
déjà.. voici un début de macro qui permet de récuperer les blocs de lignes utiles "marquées d'un X"
de trier en ordre alpha et par jour (lundi mardi;.. remplacés par 1 2 3 ...)
 

Pièces jointes

  • Tâches des Responsables_Essai_V3.xlsm
    39.4 KB · Affichages: 4

Caninge

XLDnaute Accro
Bonjour vgendron,

C'est plus que parfait !
C'est un énorme travail. Super !
En haut à gauche de la feuille FINAL., j'ai mis une forme ou objet pour activer la macro.
Sur la ligne 1 j'ai mis les jours (Je pense que c'est bon)
Je suppose que la feuille TEST sert de relai pour la macro.
Par contre les données ne s'installent pas à la ligne 3 mais beaucoup plus loin (ligne 359) voir plus.
j'ai regardé dans la macro ou pouvait se trouver ce collage. Je dirais par ici :

.UsedRange.Offset(1, 0).Delete 'on la vide SAUF la ligne des jours
For i = LBound(TabFinal, 1) To UBound(TabFinal, 1) 'pour chaque ligne
LastLine = .UsedRange.Rows.Count + 2 'on récupère le numéro de la ligne sur laquelle on va écrire

Mais bon !

A plus
Merci
 

Pièces jointes

  • Tâches des Responsables_Essai_V5.xlsm
    38 KB · Affichages: 4

vgendron

XLDnaute Barbatruc
Essaie avec ca:
VB:
Sub transferer()
Application.ScreenUpdating = False
Dim TabBase1() As Variant 'tablo de données de Base Jeudi au lundi
Dim TabBase2() As Variant ' tablo de données de Base Dimanche
Dim TabFinal() As Variant 'tablo de données finales à redisposer


Set WsBase1 = Sheets("Base Jeudi au lundi")
Set WsBase2 = Sheets("Base Dimanche")

'on récupère les données SANS entetes
With WsBase1
    TabBase1 = .UsedRange.Offset(1, 0).Value
End With

With WsBase2
    TabBase2 = .UsedRange.Offset(1, 0).Value
End With

'sur le tablo 1
For i = LBound(TabBase1, 1) To UBound(TabBase1, 1) 'pour chaque ligne
    If UCase(TabBase1(i, 1)) = "X" And TabBase1(i, 4) <> "" Then 'si on est sur un début de bloc à garder
            TabBase1(i + 1, 1) = TabBase1(i, 1) 'on recopie le X à la ligne du dessous
            TabBase1(i + 1, 2) = TabBase1(i, 2) 'on recopie le Nom à la ligne du dessous
            TabBase1(i + 1, 3) = TabBase1(i, 3) 'on recopie le tel à la ligne du dessous
            Select Case TabBase1(i, 4) ' on remplace le jour par son numéro
                Case "Lundi"
                    TabBase1(i, 4) = 1
                Case "Mardi"
                    TabBase1(i, 4) = 2
                Case "Mercredi"
                    TabBase1(i, 4) = 3
                Case "Jeudi"
                    TabBase1(i, 4) = 4
                Case "Vendredi"
                    TabBase1(i, 4) = 5
                Case "Samedi"
                    TabBase1(i, 4) = 6
                Case "Dimanche"
                    TabBase1(i, 4) = 7
            End Select
    Else 'sinon on efface la ligne complète
        For j = LBound(TabBase1, 2) To UBound(TabBase1, 2)
            TabBase1(i, j) = ""
        Next j
    End If
Next i

'on fait la meme chose sur le tablo2
For i = LBound(TabBase2, 1) To UBound(TabBase2, 1)
    If UCase(TabBase2(i, 1)) = "X" And TabBase2(i, 4) <> "" Then
            TabBase2(i + 1, 1) = TabBase2(i, 1)
            TabBase2(i + 1, 2) = TabBase2(i, 2)
            TabBase2(i + 1, 3) = TabBase2(i, 3)
            Select Case TabBase2(i, 4)
                Case "Lundi"
                    TabBase2(i, 4) = 1
                Case "Mardi"
                    TabBase2(i, 4) = 2
                Case "Mercredi"
                    TabBase2(i, 4) = 3
                Case "Jeudi"
                    TabBase2(i, 4) = 4
                Case "Vendredi"
                    TabBase2(i, 4) = 5
                Case "Samedi"
                    TabBase2(i, 4) = 6
                Case "Dimanche"
                    TabBase2(i, 4) = 7
            End Select
    Else
        For j = LBound(TabBase2, 2) To UBound(TabBase2, 2)
            TabBase2(i, j) = ""
        Next j
    End If
Next i

'on colle les deux tableaux l'un en dessous de l'autre dans la feuille test
With Sheets("Test")
    .UsedRange.Clear
    .Range("A1").Resize(UBound(TabBase1, 1), UBound(TabBase1, 2)) = TabBase1
    fin = .UsedRange.Rows.Count
    .Range("A" & fin + 1).Resize(UBound(TabBase2, 1), UBound(TabBase2, 2)) = TabBase2
    
    Set zone = .UsedRange
    'on applique un tri sur les colonnnes B et D==> les lignes vides se retrouvent en bas
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=zone.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=zone.Columns(4), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Test").Sort
        .SetRange zone
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    .Activate
    .Range("A1").Select
    TabFinal = .UsedRange.Value 'on met tout le tableau dans un tablo vba
End With


With Sheets("Final") 'dans la feuille final
    .Activate 'on l'affiche
    .UsedRange.Offset(1, 0).EntireRow.Delete 'on la vide SAUF la ligne des jours
    For i = LBound(TabFinal, 1) To UBound(TabFinal, 1) 'pour chaque ligne
        LastLine = .UsedRange.Rows.Count + 2 'on récupère le numéro de la ligne sur laquelle on va écrire
        
        If i = 1 Then 'cas particulier de la première ligne de données
            .Range("A" & LastLine) = TabFinal(i, 2) ' on colle le nom
            .Range("B" & LastLine) = TabFinal(i, 3) 'on colle le tél
        ElseIf TabFinal(i, 2) <> TabFinal(i - 1, 2) Then 'si on est sur un nouveau nom
            .Range("A" & LastLine) = TabFinal(i, 2) ' on colle le nom
            .Range("B" & LastLine) = TabFinal(i, 3) 'on colle le tél
        
        End If
        'on colle l'information = concaténation de l'heure, ville et affectation
        '.Cells(LastLine, 2 + TabFinal(i, 4)) = Format(TabFinal(i, 5), "hh:mm:ss") & " " & TabFinal(i, 6) & " " & TabFinal(i, 7)
        .Cells(LastLine, 2 + TabFinal(i, 4)) = Format(TabFinal(i, 5), "hh:mm:ss") & Chr(10) & TabFinal(i, 6) & Chr(10) & TabFinal(i, 7)
    Next i
End With
Application.ScreenUpdating = True

End Sub
 

Caninge

XLDnaute Accro
Bonjour vgendron,

-On vient de me dire qu'il faut supprimer le lundi. (enlever la colonne)
-Pour gagner de la place et économiser de l'encre serait-il possible de disposer plutôt
les lignes (heures, villes et affectations) comme sur le fichier en pièce jointe.
je ne suis pas trop embêtant ?
Merci
CANINGE
 

vgendron

XLDnaute Barbatruc
Hello
pour la concaténation.. j'avais laissé exprès les deux lignes pour que tu choisisses celle que tu veux:
éléments séparés par un espace, ou par un retour chariot

VB:
'on colle l'information = concaténation de l'heure, ville et affectation
        '.Cells(LastLine, 2 + TabFinal(i, 4)) = Format(TabFinal(i, 5), "hh:mm:ss") & " " & TabFinal(i, 6) & " " & TabFinal(i, 7)
        .Cells(LastLine, 2 + TabFinal(i, 4)) = Format(TabFinal(i, 5), "hh:mm:ss") & Chr(10) & TabFinal(i, 6) & Chr(10) & TabFinal(i, 7)

Supprimer le Lundi?? et que fait on des données qui tombent un lundi??
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…