Copie multiple au sein d'une boucle

[baptbapt]

Bonjour a tous

Voila j'ai un petit problème lors de la réalisation de ma boucle de copie.

Dim s As Worksheet

For p = 1 To NbTr
 Set s = Sheets.Add(After:=Sheets(Sheets.Count))
 s.Name = "Feuil" & 3 + p
Next p

'Copie des données de la tranche x à la feuille x+3
 Dim wS As Worksheet 'Feuille source
 Dim wD As Worksheet 'Feuille destination
 'Dim Derlig As Integer 'Derniere ligne fichier source
 'Affecte les feuilles sources/destination (de la copie)
 Set wS = Sheets("Feuil3")
 Set wD = Sheets("Feuil" & 3 + NbTr)

For t = 1 To NbTr
 J = 1
 'Determine derniere ligne fichier source
 Derlig = wS.Cells(65535, 5).End(xlUp).Row 'Derniére ligne rempli colonne 5 fichier source
 If Derlig < 2 Then
   MsgBox "Aucune données ", vbCritical
   Exit Sub
 End If
 ' Boucle sur lignes fichier source
 For I = 2 To Derlig
   If wS.Cells(I, 2) = Secteur And wS.Cells(I, 5) = NbTr Then
     'Copie ...
     wD.Rows(J).Value = wS.Rows(I).Value
     J = J + 1
   End If
 Next I
Next t

Problème, j'ai une grosse erreur dans mon système.
Il devrait, copier les données ou NbTr=1 sur la feuille 4
NbTr=2 sur la feuille 5
...
NbTr=Xsur la feuille 3+NbTr

Voila en gros le principe

Mais ma macro me copie uniquement sur la dernière page
donc si NbTr=5, il me copie les élément de la tranche5, sur la feuille 8

alors que je voudaris avoir la copie de toutes les autres tranches précédentes sur les feuilles amont.

Si quelqu'un a une solution pour moi.

Merci

[dg62]

Bonjour Baptbapt


dans cette ligne que vaut NbTr

Set wD = Sheets("Feuil" & 3 + NbTr)

je pense que ton problème vient de là.

[porcinet82]

Salut baptbapt,

Il manque un morceau de code ou pas? Parce que tu utilises la variable NbTr et tu ne la définit nul part, elle vaut donc toujours 0.

@+

Edition : Arfff, salut Didier, le temps de taper sans avoir rafraichit la page...

[baptbapt]

Salut porcinet82,dg62

NbTr est une variable que je défini plus tot dans ma macro

C'est un nombre que j'initialise a la valeur que je veu.

Set wD = Sheets("Feuil" & 3 + NbTr)
et oui je suis sur que mon erreur vien de la.
car wD sera égale à la dernière valeur, et n'évoluera pas

Avec le code complet, c'est toujours mieu

http://cjoint.com/?hypK4SAsrK

[dg62]

re


as tu essayé de mettre Set wD = Sheets("Feuil" & 3 + NbTr) à l'interieur de la boucle ?

[porcinet82]

re,

Pas sur du tout mais je dirais quelque chose du genre :

Code PHP:

For t = 1 To NbTr
Set wD = Sheets("Feuil" & 3 + t)
J = 1
Determine derniere ligne fichier source 


@+

Edition : Rhooo, c'est pas possible ca, 2 fois que tu es plus est rapide que moi, ca commence a bien faire

[baptbapt]

t ne fonctionne pas
si je met p, sa marche pas non plus

y a que ma variable NbTr qui fonctionne, mais qui me copie pas se que je veu

[baptbapt]

'Saisie du nombre de tranches d'analyse
  Do
    NbTr = InputBox("Entrez une valeur de 1 à 256", "NOMBRE DE TRANCHES DE 2 MINUTES", 10)
  Loop Until (Val(NbTr) > 0) And (Val(NbTr) < 257)

'Création des feuilles supplémentaires pour les intervals
Dim s As Worksheet

For p = 1 To NbTr
 Set s = Sheets.Add(After:=Sheets(Sheets.Count))
 s.Name = "Feuil" & 3 + p
Next p

'Copie des données de la tranche 1 à la feuille 4
 Dim wS As Worksheet 'Feuille source
 Dim wD As Worksheet 'Feuille destination
 'Dim Derlig As Integer 'Derniere ligne fichier source
 'Affecte les feuilles sources/destination (de la copie)
 Set wS = Sheets("Feuil3")
 Set wD = Sheets("Feuil4")

 J = 1
 'Determine derniere ligne fichier source
 Derlig = wS.Cells(65535, 5).End(xlUp).Row 'Derniére ligne rempli colonne 5 fichier source
 If Derlig < 2 Then
   MsgBox "Aucune données ", vbCritical
   Exit Sub
 End If
 ' Boucle sur lignes fichier source
 For I = 2 To Derlig
   If wS.Cells(I, 2) = Secteur And wS.Cells(I, 5) = 1 Then
     'Copie ...
     wD.Rows(J).Value = wS.Rows(I).Value
     J = J + 1
   End If
 Next I

Voila mon système lorsque je ne copiais pas en boucle.
Je prenais les éléments de la feuille3 et je copie en 4 les éléments ayant la valeur1 en colonne 5 de la feuille3

1 étant égale à la première valeur de NbTr

J'ai voulu mettre une boucle pour faire la meme chose sur les autres feuilles que j'ai crée.

Mais rien ni fait

[dg62]

re

For t = 1 To NbTr
Set wD = Sheets("Feuil" & 3 + t)
 J = 1
 'Determine derniere ligne fichier source
 Derlig = wS.Cells(65535, 5).End(xlUp).Row 'Derniére ligne rempli colonne 5 fichier source
 If Derlig < 2 Then
   MsgBox "Aucune données ", vbCritical
   Exit Sub
 End If
 ' Boucle sur lignes fichier source
 For I = 2 To Derlig
   If wS.Cells(I, 2) = Secteur And wS.Cells(I, 5) = NbTr Then
     'Copie ...
     wD.Rows(J).Value = wS.Rows(I).Value
     J = J + 1
   End If
 Next I
 Set wD = Nothing
Next t

[dg62]

re


If wS.Cells(I, 2) = Secteur And wS.Cells(I, 5) = t Then

[baptbapt]

Merci Didier

Problème résolut.

Enfin celui la.

Yen a d'autre, beaucoup d'autre.

Mais sa je verai demain, le boulot, c'est fini pour aujourd'hui.


Merci Didier, Merci Porcinet

[Bebere]

bonsoir Bapt,Porcinet,Dg

tu as une réponse sur l'ancien fil depuis le 21/7 à 12h56

à bientôt

[Bebere]

bonjour Bapt,Dg,Porcinet
pas certain d'avoir bien compris,mais je pense que cela t'aidera
à bientôt