Macro qui transfère des données d'une feuille à l'autre indé

Le 02/05/2016 à 22:59
11test01.xlsm (298.22 Ko)

Bonjour,

Un de vos collègue m'a fourni une macro. Elle fonctionne parfaitement dans le mini fichier que je lui ai fourni ainsi que dans mon fichier original.

Sauf que la macro arrête de transférer les données à la semaine 09.

Dans mon fichier original, j'aimerais que cette macro continue de transférer les données sans limite de semaine.

J'ai terminé la communication avec votre collègue en pensant pouvoir faire les changements par moi-même mais mes connaissance en VBA sont plus limitées que je croyais.

SVP voir pièce jointe.

Merci beaucoup pour votre aide

Le 03/05/2016 à 00:49

Salut

essayer avec ca

SVP effacer toutes les feuilles a partir de sem.01 et laisser "Abat-Neuf"

normalement les semaine s'ajoutera automatiquement sans que vous les copiez manuelement

16test02.xlsm (91.74 Ko)
Le 03/05/2016 à 02:56
20nouveau-pecheurs.xlsm (198.03 Ko)

Bonsoir Amir,

Merci beaucoup pour ta réponse rapide.

Ça fonctionne parfaitement pour ce qui est de l'ajout des semaines mais cette option ne peux pas fonctionner pour mon système. Il y aura beaucoup d'autres données dans chacune des semaines qui ne sont liées qu'à la semaine en question.

Exemple: Les données de la sem.01 sont différentes de celles de la sem.02 et ainsi de suite.....

Ton option crée toujours la même semaine avec les même données.

Ça cause quelques problèmes.

Les données de la semaine souche ne doivent pas s'effacer après le transfert.

Seul les données de la colonne B doivent transférer d'une semaine à l'autre semaine.

Puis-je suggérer une autre solution ?

Si les données des colonnes G,H, de la feuilles "Données" se mettent à jour en additionnant les données des colonnes M et N après le transfert de chaque semaine, les colonnes O et P, pourraient disparaître. Il suffirait d'ajouter une formule dans la colonne F de la feuille "Données" qui diviserait le total de la colonne H par le total de la colonne G. Il faudrait que la macro n'affecte plus la colonne F de la feuille "Données".

Voir pièce jointe.

Si c'est possible, se serait formidable.

Merci encore pour ton aide. C'est très apprécié.

Le 03/05/2016 à 12:09

BONJOUR

Ça fonctionne parfaitement pour ce qui est de l'ajout des semaines mais cette option ne peux pas fonctionner pour mon système

je sai tres bien que ce code ne creer pas la feuille de la semaine suivante avec des donnees convenables ,j ai modifie le code seulement pour éviter les bugs a cause de nbrs des feuille qui se change selon les besoin ou bien qui se cache dans votre fichier principale, vous pouvez modifier la feuille apres ca creation comme vous le fait manuelement

pour les données des colonnes M et N après le transfert de chaque semaine ,normalement j'ai modifier le code pour le faire

et le code n'affecte plus la colonne F de la feuille "Données"

mais vérifier que les dones sont bien copies et n ont chane de lordre M ET N !

Mais que voulez vous dire par :

Les données de la semaine souche ne doivent pas s'effacer après le transfert.

et par :

Seul les données de la colonne B doivent transférer d'une semaine à l'autre semaine.

le code :

Dim sh_distan As Worksheet, sh_source As Worksheet
Private Sub Test_Onglet()

    On Error Resume Next
    Err = 0
    sh_source.Copy After:=sh_source
If sh_source.Name = "Abat-Neuf" Then
   ActiveSheet.Name = "Sem.01"
ElseIf Not sh_source.Name = "Abat-Neuf" And Not sh_source.Name = "Données" Then ' si vous ajouter une fuille a jouter ici!

    If Val(Mid(ActiveSheet.Name, 5)) < 9 Then
    ActiveSheet.Name = "Sem.0" & (Val(Mid(sh_source.Name, 5)) + 1)
    ElseIf Val(Mid(ActiveSheet.Name, 5)) >= 9 Then
    ActiveSheet.Name = "Sem." & (Val(Mid(sh_source.Name, 5)) + 1)
    End If
End If

    If Err <> 0 Then
        Application.DisplayAlerts = False
        ActiveSheet.Delete        'détruit la feuille créée
        Application.DisplayAlerts = True

    End If
End Sub
Sub standar()
Dim T
Dim i As Integer, j As Integer

Application.ScreenUpdating = False

' "Sem.01"  >>>> "Sem.09" >>>> "Sem.10">>>> "Sem.15" .........

If ActiveSheet.Name = "Abat-Neuf" Then

  Set sh_source = Worksheets("Abat-Neuf") ' A la place de sh_source = "Abat-Neuf"
  Call Test_Onglet
  Set sh_distan = Worksheets("Sem.01")    'A la place desh_distan = "Sem.01"
  sh_distan.Range("A1").Value = sh_distan.Name
  sh_distan.Range("B2:B160").Value = sh_source.Range("B2:B160").Value

ElseIf Not ActiveSheet.Name = "Abat-Neuf" And Not ActiveSheet.Name = "Données" Then ' si vous ajouter une fuille a jouter ici!

  If Val(Mid(ActiveSheet.Name, 5)) < 9 Then ' 4 parsque vous aver que 4 semaine encore
  Set sh_source = Worksheets(ActiveSheet.Name) ' A la place de sh_source = "Abat-Neuf"
    Call Test_Onglet
  Set sh_distan = Worksheets("Sem.0" & (Val(Mid(sh_source.Name, 5)) + 1))
  sh_distan.Range("A1").Value = sh_distan.Name
  sh_distan.Range("B2:B160").Value = sh_source.Range("B2:B160").Value

  ElseIf Val(Mid(ActiveSheet.Name, 5)) >= 9 Then
   Set sh_source = Worksheets(ActiveSheet.Name)
   Call Test_Onglet
  Set sh_distan = Worksheets("Sem." & (Val(Mid(sh_source.Name, 5)) + 1))
  sh_distan.Range("A1").Value = sh_distan.Name
  sh_distan.Range("B2:B160").Value = sh_source.Range("B2:B160").Value

  End If

End If

If Not sh_source Is Nothing Then

For j = 2 To 100
   If sh_source.Range("B" & j).Value <> "" Then
   Set T = Worksheets("Données").Range("A2:A1003").Find(sh_source.Range("B" & j).Value)
   If Not T Is Nothing Then
   With Worksheets("Données")
'  .Range("F" & T.Row).Value = sh_source.Range("d" & j).Value
  .Range("G" & T.Row).Value = sh_source.Range("M" & j).Value
  .Range("H" & T.Row).Value = sh_source.Range("N" & j).Value
 ' .Range("G" & T.Row).Value = sh_source.Range("O" & j).Value
 ' .Range("H" & T.Row).Value = sh_source.Range("P" & j).Value
   End With
   End If
   End If
Next
End If

 If Not sh_source Is Nothing Then
  For i = 0 To 10
   sh_source.Range("E" & 2 + (10 * i) & ":L" & 10 + (10 * i)).ClearContents
   sh_source.Range("E" & 7 + (1 * i) & ":L" & 8 + (1 * i)).ClearContents
   Next
 End If

 If Not sh_source Is Nothing Then
sh_distan.Activate
End If

  Application.ScreenUpdating = True

End Sub
Le 03/05/2016 à 15:51

Bonjour Amir,

Tu as entièrement raison. Avec ce code je devrais être capable d'ajouter les données que je désire transférer. J'ai fais l'expérience et ça fonctionne très bien.

J'ai un problème avec le transfert des données dans les colonne G et H de la feuille "Données". Je suis désolé mais je n'ai pas été assez claire. J'aurais du mentionné dans les commentaires que les données doivent s'accumuler d'une semaine à l'autre afin d'avoir les données accumulées du joueurs durant toute la durée du jeu, mon erreur. Les données doivent parvenir des colonnes M et N de chaque semaine. De cette façon je pourrai éliminer les colonnes O et P qui ne serviront plus à rien.

Concernant: "Les données de la semaine souche ne doivent pas s'effacer", j'ai effacer la partie de ton code "ClearContents" et les données de la semaine précédente ne s'efface plus. C'est réglé.

Pour ce qui est de: "Seul les données de la colonne "B" doivent transférer d'une semaine à l'autre", voici ce que je veux dire:

Lorsque que j'active le bouton "Transférer" les données entrées manuellement à chaque semaine, dans les colonnes E,F,G,H,I,J,K,L, ne doivent pas transférer dans la prochaine semaine. Sinon, je dois les effacer avant d'entrer les nouvelle données manuellement.

En ne transférant que les données de la colonne "B" seul les numéros des joueurs transfèrent et c'est parfait comme ça.

Merci et bonne journée

Le 05/05/2016 à 16:04

Bonjour Amir,

As tu eu la chance de regarder mon message ?

Merci et bonne journée

Le 06/05/2016 à 00:21

Salut

vouler vous dire par :

les données doivent s'accumuler d'une semaine à l'autre afin d'avoir les données accumulées du joueurs durant toute la durée du jeu

les donnsemaineées doivent s'additionner d'une semaine à l'autre afin d'avoir un total des points gagne durant toute la durée du jeu semaine01=201 + semaine02= 405 total =606

Le 06/05/2016 à 01:37

Bonjour Amir,

C'est exactement ça pour les deux colonnes M et N,

Les données des colonnes M de chaque semaine s'additionnent dans la colonne G de la feuille "Données" et celles de la colonne N de chaque semaine s'additionnent dans la colonne H de la feuille "Données".

Merci et bonne soirée

Le 06/05/2016 à 12:19

BONJOUR

vérifier si les cellules de g,h et de m,n sont au format "nombre" pour que le code les traite comme des nombres et puisse les additionnent les un avec les autres

Option Explicit

    Dim sh_distan As Worksheet, sh_source As Worksheet
    Private Sub Test_Onglet()

        On Error Resume Next
        Err = 0
        sh_source.Copy After:=sh_source
    If sh_source.Name = "Abat-Neuf" Then
       ActiveSheet.Name = "Sem.01"
    ElseIf Not sh_source.Name = "Abat-Neuf" And Not sh_source.Name = "Données" Then ' si vous ajouter une fuille a jouter ici!

        If Val(Mid(ActiveSheet.Name, 5)) < 9 Then
        ActiveSheet.Name = "Sem.0" & (Val(Mid(sh_source.Name, 5)) + 1)
        ElseIf Val(Mid(ActiveSheet.Name, 5)) >= 9 Then
        ActiveSheet.Name = "Sem." & (Val(Mid(sh_source.Name, 5)) + 1)
        End If
    End If

        If Err <> 0 Then
            Application.DisplayAlerts = False
            ActiveSheet.Delete        'détruit la feuille créée
           Application.DisplayAlerts = True

        End If
    End Sub
    Sub standar()
    Dim T
    Dim i As Integer, j As Integer

    Application.ScreenUpdating = False

    ' "Sem.01"  >>>> "Sem.09" >>>> "Sem.10">>>> "Sem.15" .........

    If ActiveSheet.Name = "Abat-Neuf" Then

      Set sh_source = Worksheets("Abat-Neuf") ' A la place de sh_source = "Abat-Neuf"
     Call Test_Onglet
      Set sh_distan = Worksheets("Sem.01")    'A la place desh_distan = "Sem.01"
     sh_distan.Range("A1").Value = sh_distan.Name
      sh_distan.Range("B2:B160").Value = sh_source.Range("B2:B160").Value

    ElseIf Not ActiveSheet.Name = "Abat-Neuf" And Not ActiveSheet.Name = "Données" Then ' si vous ajouter une fuille a jouter ici!

      If Val(Mid(ActiveSheet.Name, 5)) < 9 Then ' 4 parsque vous aver que 4 semaine encore
     Set sh_source = Worksheets(ActiveSheet.Name) ' A la place de sh_source = "Abat-Neuf"
       Call Test_Onglet
      Set sh_distan = Worksheets("Sem.0" & (Val(Mid(sh_source.Name, 5)) + 1))
      sh_distan.Range("A1").Value = sh_distan.Name
      sh_distan.Range("B2:B160").Value = sh_source.Range("B2:B160").Value

      ElseIf Val(Mid(ActiveSheet.Name, 5)) >= 9 Then
       Set sh_source = Worksheets(ActiveSheet.Name)
       Call Test_Onglet
      Set sh_distan = Worksheets("Sem." & (Val(Mid(sh_source.Name, 5)) + 1))
      sh_distan.Range("A1").Value = sh_distan.Name
      sh_distan.Range("B2:B160").Value = sh_source.Range("B2:B160").Value

      End If

    End If

    If Not sh_source Is Nothing Then

    For j = 2 To 100
       If sh_source.Range("B" & j).Value <> "" Then
       Set T = Worksheets("Données").Range("A2:A1003").Find(sh_source.Range("B" & j).Value)
       If Not T Is Nothing Then
       With Worksheets("Données")
    '  .Range("F" & T.Row).Value = sh_source.Range("d" & j).Value
     .Range("G" & T.Row).Value = .Range("G" & T.Row).Value + sh_source.Range("M" & j).Value
     .Range("H" & T.Row).Value = .Range("H" & T.Row).Value + sh_source.Range("N" & j).Value
     ' .Range("G" & T.Row).Value = sh_source.Range("O" & j).Value
    ' .Range("H" & T.Row).Value = sh_source.Range("P" & j).Value
      End With
       End If
       End If
    Next
    End If
     If Not sh_source Is Nothing Then
      For i = 0 To 10
       sh_source.Range("E" & 2 + (10 * i) & ":L" & 10 + (10 * i)).ClearContents
       sh_source.Range("E" & 7 + (1 * i) & ":L" & 8 + (1 * i)).ClearContents
       Next
     End If

     If Not sh_source Is Nothing Then
    sh_distan.Activate
    End If

      Application.ScreenUpdating = True

    End Sub
Le 06/05/2016 à 15:11

Bonjour Amir,

Tu es un génie. Tout fonctionne parfaitement.

Je te remercie pour ta patience et ta persévérance.

Bonne journée.

Rechercher des sujets similaires à "macro qui transfere donnees feuille inde"