Transfer les donnees d'une plage dans d'autres plage..

Guido

XLDnaute Accro
Bonsoir le Forum

Je recherches a transferer des lignes dans des plages bien définies selon le titre de la plage de base

Cette plage change tout les jours

Voir le fichier en piece jointe

Merci

Guido
 

Pièces jointes

  • Seléction final 2016.xls
    59.5 KB · Affichages: 42

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonsoir Guido,

Vu l'énoncé de la question, je ne sais pas si j'ai compris correctement.
En tous cas je dispatche le tableau [A:E] de Feuil1 vers Feuil2.
C'est limité à 5 réunions max et 10 chevaux max par réunion.

Question : un doute m'habite. Les chevaux sont-ils toujours codifiés "R.un nombre-C.un nombre" ou bien est-ce-que leur nom peut être n'importe quoi ? Dans le fichier joint, j'ai considéré que les chevaux été codifié comme ci-dessus mentionné.

Voir v2 ICI.
 
Dernière édition:

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Salut mapomme

Merci pour ta reponse rapide.

Seul hic,la macros efface le contenu qui se trouve de la ligne 15 a 27 voir bien plus

Peut tu regarder SVP

Amitiés

Guido
 

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour Guido, mapomme, le forum,

Vous avez eu scrupule à continuer sur cet autre fil déjà bien long, et vous avez eu raison :

https://www.excel-downloads.com/threads/resolu.20006955/

Mais le plus simple est de le continuer, voyez ce fichier (8).

Bonne journée.
 

Pièces jointes

  • TABLEAUX DES COURSES TRANSFEREES 2016(8).xls
    266.5 KB · Affichages: 34
Dernière édition:

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Dans la foulée j'ai complété dans ce fichier (9) les tableaux ARRIVEE OFFICIELLE.

Voyez les 4 formules en A17 B17 C17 D17 à tirer vers le bas puis à recopier sur les autres tableaux.

Je ne sais pas ce qu'il faut mettre dans les colonnes ZC.

A+
 

Pièces jointes

  • TABLEAUX DES COURSES TRANSFEREES 2016(9).xls
    387.5 KB · Affichages: 35

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour job75 et le Forum

Hier je voulais ajouter dans la barre du titre Resolu. et c'est le mot Resolu qui est rester afficher

suite a ca un membre du Forum JCGL ma fait remarquer mon erreur avec raison.et ne sachant comment retablire

le soucis..j'ai demander la solution par mp.et je n'ai pas eu de reponse.

voila la raison pour laquelle j'ai refait un nv post..

Je me suis excusé.car je respecte le Forum,c'est le premier soucis en 11 ans de participation.

Re

Job75

je te remercie pour la derniere modification,SUPER

Bon dimanche a plus

Guido
 

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Dans la foulée j'ai complété dans ce fichier (9) les tableaux ARRIVEE OFFICIELLE.

Voyez les 4 formules en A17 B17 C17 D17 à tirer vers le bas puis à recopier sur les autres tableaux.

Je ne sais pas ce qu'il faut mettre dans les colonnes ZC.

A+

Re

job75 nos post se sont croisés.

Merci pour se rajout tres pratique.

Le ZC en pour le cheval arrivé 4 em.

Dans la journée ,je vais ajouté une MFC afin de visualiser la reussite de chaque pronos selon l'arrivee.

en vba je le repette suis nul.

A plus

Amitiés

Guido
 

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

La macro Workbook_SheetActivate ne me plaisait pas trop, je préfère celle-ci, plus simple et plus logique :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Frecap As Worksheet, F As Worksheet, i&, lig&, x$, P As Range, rc As Byte
Dim colrecap%, ligrecap&, j As Byte, k As Byte
Static recap As Boolean 'mémorise la variable
Set Frecap = Feuil1 'CodeName de la feuille Récap
Set F = Feuil2 'CodeName de la feuille Prono
With Sh
  If .Name Like "TAB R#*" Then
    Application.ScreenUpdating = False
    .Cells.Clear 'RAZ
    lig = 1
    x = "Course: R." & Val(Mid(.Name, 6)) & "-*"
    For i = 1 To F.Cells(.Rows.Count, 2).End(xlUp).Row
      If F.Cells(i, 2) Like x Then
        '---copie du tableau source---
        Set P = F.Range(F.Cells(i, 1), F.Cells(i + 6, 2).CurrentRegion)
        rc = P.Rows.Count
        P.Rows("1:8").Copy .Cells(lig, 1) 'début
        P.Rows(9).Resize(rc - 18, 6).Copy .Cells(lig + 8, 1) 'milieu, colonnes A à F
        P(rc - 9, 2).Resize(, 3).Copy .Cells(lig + 28, 2) 'pour les formats
        .Cells(lig + 28, 2) = "Chevaux"
        P.Rows(rc - 8).Resize(9).Copy .Cells(lig + 29, 1) 'fin
        '---initialisation et 1ère colonne du tableau dans Récap---
        If recap Then
          colrecap = 6 * Val(Mid(.Name, 6)) - 5
          ligrecap = Frecap.Columns(colrecap) _
            .Find("", Frecap.Cells(2, colrecap), xlValues, , xlByColumns).Row
          Frecap.Cells(ligrecap, colrecap) = Trim(Mid(.Cells(lig, 2), 9, 8))
        End If
        '---traitement du milieu du tableau---
        With .Cells(lig + 8, 1).Resize(20, 8) '2 colonnes auxiliaires G et H
          .Columns(3).Interior.ColorIndex = xlNone 'RAZ des couleurs
          For j = 1 To 20
            If .Cells(j, 2) <> "" Then
              .Cells(j, 1) = .Cells(j, 2)
              .Cells(j, 4) = Val(Replace(.Cells(j, 4), ",", "."))
              .Cells(j, 5) = Val(Replace(.Cells(j, 5), ",", "."))
              .Cells(j, 3) = .Cells(j, 4) - .Cells(j, 5)
              If .Cells(j, 3) < 0 Then .Cells(j, 7) = -.Cells(j, 3) _
                Else .Cells(j, 8) = .Cells(j, 3) 'séparation des valeurs
            Else
              For k = 1 To 20
                If Application.CountIf(.Columns(1), k) = 0 Then .Cells(j, 1) = k: Exit For
              Next k
            End If
          Next j
          .Sort .Columns(7), xlAscending, Header:=xlNo 'tri des valeurs < 0
          If .Cells(1, 7) <> "" Then
            .Cells(1, 3).Interior.ColorIndex = 3: .Cells(1, 3).Font.ColorIndex = 6
            .Cells(1, 3).Copy .Cells(22, 5)
            .Cells(1, 2).Copy .Cells(21, 5)
            If recap Then Frecap.Cells(ligrecap, colrecap + 1) = .Cells(1, 3): _
              Frecap.Cells(ligrecap, colrecap + 2) = .Cells(1, 2)
          End If
          .Sort .Columns(8), xlAscending, Header:=xlNo 'tri des valeurs >= 0
          If .Cells(1, 8) <> "" Then
            .Cells(1, 3).Interior.ColorIndex = 49: .Cells(1, 3).Font.ColorIndex = 6
            .Cells(1, 3).Copy .Cells(22, 6)
            .Cells(1, 2).Copy .Cells(21, 6)
            If recap Then Frecap.Cells(ligrecap, colrecap + 3) = .Cells(1, 3): _
              Frecap.Cells(ligrecap, colrecap + 4) = .Cells(1, 2)
          End If
          .Columns(7).Resize(, 2) = "" 'RAZ des colonnes auxiliaires
          .Sort .Columns(1), xlAscending, Header:=xlNo 'tri dans l'ordre normal
          '---mises en forme de la 1ère colonne---
          With .Columns(1)
            .Borders.Weight = xlThin
            .Interior.ColorIndex = 16 'gris
            .Font.ColorIndex = 6 'jaune
            .HorizontalAlignment = xlCenter
          End With
        End With
        '---bordures---
        .Cells(lig, 2).Resize(38, P.Columns.Count - 1).Borders.Weight = xlThin
        lig = lig + 38
      End If
    Next i
  ElseIf .Name = Frecap.Name Then
    Application.ScreenUpdating = False
    .Rows("3:12").ClearContents 'RAZ
    recap = True
    For Each Sh In Worksheets
      If Sh.Name Like "TAB R#*" Then Workbook_SheetActivate Sh
    Next Sh
    recap = False
  End If
  ActiveCell.Select
  With .UsedRange: End With 'actualise la barre de défilement
End With
End Sub
Elle utilise 3 tris intermédiaires [Edit] et l'on gagne 33% sur la durée d'exécution.

Fichier (10).

A+
 

Pièces jointes

  • TABLEAUX DES COURSES TRANSFEREES 2016(10).xls
    292.5 KB · Affichages: 45
Dernière édition:

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Dans la journée ,je vais ajouté une MFC afin de visualiser la reussite de chaque pronos selon l'arrivee.

Au cas où vous auriez des difficultés voyez ce fichier (11).

Il y a 2 MFC, en C3 et E3, chacune avec 3 conditions traitant les colonnes 1er 2è 3è.

Sur Excel 2007 et versions suivantes on pourrait ajouter une 4ème condition traitant la colonne ZC.

Les formules sont très simples.

A+
 

Pièces jointes

  • TABLEAUX DES COURSES TRANSFEREES 2016(11).xls
    410 KB · Affichages: 41
Dernière édition:

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Ce n'était pas fini avec la macro :rolleyes:

J'aurais dû comprendre qu'en colonne A des feuilles "TAB" c'était l'ordre des arrivées qu'il fallait mettre !

Guido m'a alerté par MP, merci à lui.

La macro est alors plus simple, heureusement la modification était facile :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Frecap As Worksheet, F As Worksheet, i&, lig&, x$, P As Range, rc As Byte
Dim colrecap%, ligrecap&, j As Byte
Static recap As Boolean 'mémorise la variable
Set Frecap = Feuil1 'CodeName de la feuille Récap
Set F = Feuil2 'CodeName de la feuille Prono
With Sh
  If .Name Like "TAB R#*" Then
    Application.ScreenUpdating = False
    .Cells.Clear 'RAZ
    lig = 1
    x = "Course: R." & Val(Mid(.Name, 6)) & "-*"
    For i = 1 To F.Cells(.Rows.Count, 2).End(xlUp).Row
      If F.Cells(i, 2) Like x Then
        '---copie du tableau source---
        Set P = F.Range(F.Cells(i, 1), F.Cells(i + 6, 2).CurrentRegion)
        rc = P.Rows.Count
        P.Copy .Cells(lig, 1)
        .Rows(lig + rc - 10) = "": .Cells(lig + rc - 10, 2) = "Chevaux"
        '---initialisation et 1ère colonne du tableau dans Récap---
        If recap Then
          colrecap = 6 * Val(Mid(.Name, 6)) - 5
          ligrecap = Frecap.Columns(colrecap) _
            .Find("", Frecap.Cells(2, colrecap), xlValues, , xlByColumns).Row
          Frecap.Cells(ligrecap, colrecap) = Trim(Mid(.Cells(lig, 2), 9, 8))
        End If
        '---traitement du milieu du tableau---
        With .Cells(lig + 8, 1).Resize(rc - 18, 8) '2 colonnes auxiliaires G et H
          .Columns(7).Resize(, P.Columns.Count - 6).Clear 'RAZ à partir de la colonne G
          .Columns(3).Interior.ColorIndex = xlNone 'RAZ des couleurs en colonne C
          For j = 1 To rc - 18
            .Cells(j, 1) = j
            .Cells(j, 4) = Val(Replace(.Cells(j, 4), ",", "."))
            .Cells(j, 5) = Val(Replace(.Cells(j, 5), ",", "."))
            .Cells(j, 3) = .Cells(j, 4) - .Cells(j, 5)
            If .Cells(j, 3) < 0 Then .Cells(j, 7) = -.Cells(j, 3) _
              Else .Cells(j, 8) = .Cells(j, 3) 'séparation des valeurs
          Next j
          .Sort .Columns(7), xlAscending, Header:=xlNo 'tri des valeurs < 0
          If .Cells(1, 7) <> "" Then
            .Cells(1, 3).Interior.ColorIndex = 3: .Cells(1, 3).Font.ColorIndex = 6
            .Cells(1, 3).Copy .Cells(rc - 16, 5)
            .Cells(1, 2).Copy .Cells(rc - 17, 5)
            If recap Then Frecap.Cells(ligrecap, colrecap + 1) = .Cells(1, 3): _
              Frecap.Cells(ligrecap, colrecap + 2) = .Cells(1, 2)
          End If
          .Sort .Columns(8), xlAscending, Header:=xlNo 'tri des valeurs >= 0
          If .Cells(1, 8) <> "" Then
            .Cells(1, 3).Interior.ColorIndex = 49: .Cells(1, 3).Font.ColorIndex = 6
            .Cells(1, 3).Copy .Cells(rc - 16, 6)
            .Cells(1, 2).Copy .Cells(rc - 17, 6)
            If recap Then Frecap.Cells(ligrecap, colrecap + 3) = .Cells(1, 3): _
              Frecap.Cells(ligrecap, colrecap + 4) = .Cells(1, 2)
          End If
          .Columns(7).Resize(, 2) = "" 'RAZ des colonnes auxiliaires
          .Sort .Columns(1), xlAscending, Header:=xlNo 'tri dans l'ordre normal
          '---mises en forme de la 1ère colonne---
          With .Columns(1)
            .Borders.Weight = xlThin
            .Interior.ColorIndex = 16 'gris
            .Font.ColorIndex = 6 'jaune
            .HorizontalAlignment = xlCenter
          End With
        End With
        '---bordures---
        .Cells(lig, 2).Resize(rc, P.Columns.Count - 1).Borders.Weight = xlThin
        lig = lig + rc
      End If
    Next i
  ElseIf .Name = Frecap.Name Then
    Application.ScreenUpdating = False
    .Rows("3:12").ClearContents 'RAZ
    recap = True
    For Each Sh In Worksheets
      If Sh.Name Like "TAB R#*" Then Workbook_SheetActivate Sh
    Next Sh
    recap = False
  End If
  ActiveCell.Select
  With .UsedRange: End With 'actualise la barre de défilement
End With
End Sub
Fichier (12) joint, par rapport au fichier (11) on gagne encore 23% sur la durée d'exécution.

A+
 

Pièces jointes

  • TABLEAUX DES COURSES TRANSFEREES 2016(12).xls
    288.5 KB · Affichages: 38
Dernière édition:

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Re

job75 et le forum

Ma demande, pour ce fichier:

l'important de selection sont les valeur négatives et les valeur positives le plus prêt de ZERO.

Dans la page recap les arrivees ne sont plus utilisable apres avoir actualiser une nv journéé

voici mes derniere precision

a plus

Guido
 

Pièces jointes

  • Capture apres l'insertion du nv journee page recup..,,,.jpg
    Capture apres l'insertion du nv journee page recup..,,,.jpg
    95.4 KB · Affichages: 30

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour Guido, le forum,

Bon à chaque chargement des données en feuille "Prono" vous supprimez les cellules !

Donc il ne faut pas de formules en feuille "Récap".

Nouvelle macro :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Frecap As Worksheet, F As Worksheet, i&, lig&, x$, P As Range, rc As Byte
Dim colrecap%, ligrecap&, y$, t, j As Byte
Static recap As Boolean 'mémorise la variable
Set Frecap = Feuil1 'CodeName de la feuille Récap
Set F = Feuil2 'CodeName de la feuille Prono
With Sh
  If .Name Like "TAB R#*" Then
    Application.ScreenUpdating = False
    .Cells.Clear 'RAZ
    lig = 1
    x = "Course: R." & Val(Mid(.Name, 6)) & "-*"
    For i = 1 To F.Cells(.Rows.Count, 2).End(xlUp).Row
      If F.Cells(i, 2) Like x Then
        '---copie du tableau source---
        Set P = F.Range(F.Cells(i, 1), F.Cells(i + 6, 2).CurrentRegion)
        rc = P.Rows.Count
        P.Copy .Cells(lig, 1)
        .Rows(lig + rc - 10) = "": .Cells(lig + rc - 10, 2) = "Chevaux"
        '---initialisation et en-têtes des tableaux dans Récap---
        If recap Then
          colrecap = 6 * Val(Mid(.Name, 6)) - 5
          ligrecap = Frecap.Columns(colrecap) _
            .Find("", Frecap.Cells(2, colrecap), xlValues, , xlByColumns).Row
          y = Trim(Mid(P(1, 2), 9, 8))
          y = Replace(Replace(y, ".", ""), "-", "")
          If ligrecap = 3 Then Frecap.Cells(2, colrecap) = Split(y, "C")(0)
          Frecap.Cells(ligrecap, colrecap) = y
          Frecap.Cells(ligrecap + 14, colrecap) = y 'tableau des arrivées
        End If
        '---traitement du milieu du tableau---
        With .Cells(lig + 8, 1).Resize(rc - 18, 8) '2 colonnes auxiliaires G et H
          .Columns(7).Resize(, P.Columns.Count - 6).Clear 'RAZ à partir de la colonne G
          .Columns(3).Clear 'RAZ colonne C
          .Columns(3).HorizontalAlignment = xlCenter 'centrage
          t = .Value 'matrice, plus rapide
          For j = 1 To rc - 18
            t(j, 1) = j
            t(j, 4) = Val(Replace(t(j, 4), ",", "."))
            t(j, 5) = Val(Replace(t(j, 5), ",", "."))
            t(j, 3) = t(j, 4) - t(j, 5)
            If t(j, 3) < 0 Then
              t(j, 7) = -t(j, 3)
            ElseIf t(j, 3) > 0 Then 'valeurs zéro non traitées
              t(j, 8) = t(j, 3)
            End If
          Next j
          .Value = t
          .Sort .Columns(7), xlAscending, Header:=xlNo 'tri des valeurs < 0
          If .Cells(1, 7) <> "" Then
            .Cells(1, 3).Interior.ColorIndex = 3: .Cells(1, 3).Font.ColorIndex = 6
            .Cells(1, 3).Copy .Cells(rc - 16, 5)
            .Cells(1, 2).Copy .Cells(rc - 17, 5)
            If recap Then Frecap.Cells(ligrecap, colrecap + 1) = .Cells(1, 3): _
              Frecap.Cells(ligrecap, colrecap + 2) = .Cells(1, 2)
          End If
          .Sort .Columns(8), xlAscending, Header:=xlNo 'tri des valeurs > 0
          If .Cells(1, 8) <> "" Then
            .Cells(1, 3).Interior.ColorIndex = 49: .Cells(1, 3).Font.ColorIndex = 6
            .Cells(1, 3).Copy .Cells(rc - 16, 6)
            .Cells(1, 2).Copy .Cells(rc - 17, 6)
            If recap Then Frecap.Cells(ligrecap, colrecap + 3) = .Cells(1, 3): _
              Frecap.Cells(ligrecap, colrecap + 4) = .Cells(1, 2)
          End If
          .Columns(7).Resize(, 2) = "" 'RAZ des colonnes auxiliaires
          .Sort .Columns(1), xlAscending, Header:=xlNo 'tri dans l'ordre normal
          '---mises en forme de la 1ère colonne---
          With .Columns(1)
            .Borders.Weight = xlThin
            .Interior.ColorIndex = 16 'gris
            .Font.ColorIndex = 6 'jaune
            .HorizontalAlignment = xlCenter
          End With
        End With
        '---bordures---
        .Cells(lig, 2).Resize(rc, P.Columns.Count - 1).Borders.Weight = xlThin
        lig = lig + rc
      End If
    Next i
  ElseIf .Name = Frecap.Name Then
    Application.ScreenUpdating = False
    .[2:2,17:26].Replace "R*", "", xlWhole 'RAZ
    .[3:12].ClearContents 'RAZ
    recap = True
    For Each Sh In Worksheets
      If Sh.Name Like "TAB R#*" Then Workbook_SheetActivate Sh
    Next Sh
    recap = False
  End If
  ActiveCell.Select
  With .UsedRange: End With 'actualise la barre de défilement
End With
End Sub
Comme vous l'avez demandé les valeurs zéro ne sont plus traitées.

Edit 1 : j'ai modifié compte tenu du post #15.

Edit 2 : je n'avais pas centré la colonne C.

Fichier (13).

Bonne journée.
 

Pièces jointes

  • TABLEAUX DES COURSES TRANSFEREES 2016(13).xls
    261.5 KB · Affichages: 51
Dernière édition:

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour job et le Forum

Merci pour le fichier modifier avec succes avec les valeurs selon ma demande.

Dans la feuille recap j'ai ajouté une macro afin d'effacer les arrivées qui ne sont pas les arrivee reel...

PRECISION IMPORTANTE:

Les chiffres qui se trouvent dans la colonne B represente le classement des chx classer de la plus petite cote a la plus grande cote.

Et NON le classement de l'arrivee.

Les arrivees sont a rentrer manuellement pour le moment

Merci pour votre attention,

si vous avez une possibilité d'ajouté une emplacement dans chaque plage des feuilles TAB R1..2..3..4..5

merci de m'aider

Amitiés

Guido
 

Pièces jointes

  • COURSES EN DIRECT MODELE 2016.VF.01.xls
    484.5 KB · Affichages: 33

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
314 210
Messages
2 107 298
Membres
109 796
dernier inscrit
aelgar