copier des données les unes à la suite des autres

[taty]

Bonjour à tous
j'ai un problème qui me rend folle!!!!
en effet, j'ai des données dans des feuilles nommées de lundi jusqu'à vendredi.
ensuite, j'ai des informations dans chaque feuille allant de la cellule B11 j'usquà K11 en colonne. la ligne occupées sont varaables d'une semaine à une autres.
ensuite j'ai fait une macro qui me permet d'archiver les informations de chaque feuille du lundi jusqu'au vendredi dans une feuille nommée "archives".
voici la macro que j'ai faite:
sub archiver()
'
' Sheets("lundi").Select
Range("B11:K11").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("archives").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("mardi").Select
Range("B11:K11").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("archives").Select
Range("A9").Select
ActiveSheet.Paste
Sheets("mercredi").Select
Range("B11:K11").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("archives").Select
Range("A10").Select
ActiveSheet.Paste
Sheets("jeudi").Select
Range("B11:K11").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("archives").Select
Range("A11").Select
ActiveSheet.Paste
Sheets("Vendredi").Select
Range("B11:K11").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("archives").Select
Range("A15").Select
ActiveSheet.Paste
End Sub
Ensuite j'aimerais faire une deuxième macro qui me permette d'exécuter cette première macro autant de fois que j'aimerais tout en tenant compte de la dernière ligne non vide dans feuille "archives"
SVP aidez moi!!!!!

 

[tototiti2008]

Re : copier des données les unes à la suite des autres

Bonjour taty,

sans voir à quoi ressemblent les données sur lesquelles doit s'appliquer la macro, difficile...

 

[Robert]

Re : copier des données les unes à la suite des autres

Bonjour Taty, Tototiti, bonjour le forum,

Si les 5 premiers onglets de ton classeurs sont les onglets de jour (Lundi, Mardi, Mercredi, Jeudi et Vendredi) la macro ci-dessous devrait te convenir (Sinon il faudrait supprimer la boucle et faire la même chose en nommant les onglet un par un) :

Sub Macro1()
Dim dest As Range 'déclare la variable dest (DESTination)
 
For x = 1 To 5 'boucle sur les 5 premiers onglets ("Lundi", Mardi", etc...)
    'définit la cellule de destination
    If Sheets("archives").Range("A3").Value = "" Then 'condition : si A3 est vide
        Set dest = Sheets("archives").Range("A3") 'dest = A3
    Else 'sinon
        'dest est la première cellule vide de la colonne A
        Set dest = Sheets("archives").Range("A65536").End(xlUp).Offset(1, 0)
    End If 'fin de la condition
    'copy toutes les cellules adjacentes à B11 et les colle dans dest
    Sheets(x).Range("B11").CurrentRegion.Copy dest
Next x 'prochain onglet de la boucle
End Sub

 

[taty]

Re : copier des données les unes à la suite des autres

Bonjou Robert
je tiens à te remercier pour ton aide.
en en réalité, la macro marche mais elle me reprend systématiquement les entêtes de chaque feuille avec. Comment je peus enléver les entêtes? Stp

 

[Robert]

Re : copier des données les unes à la suite des autres

Bonjour le fil, bonjour le forum,

Si tu mettais un petit fichier exemple avec juste quelques données, je pourrais adapter la macro...

 

[tototiti2008]

Re : copier des données les unes à la suite des autres

Re,
Bonjour Robert,

peut-être en modifiant le code de robert comme ça :

modifie

Sheets(x).Range("B11").CurrentRegion.Copy dest

en

Sheets(x).Range("B11").CurrentRegion.Offset(1,0).resize(Sheets(x).Range("B11").CurrentRegion.rows.count -1,).Copy dest

 

[Robert]

Re : copier des données les unes à la suite des autres

Bonjour le fil, bonjour le forum,

Oui Tototiti j'étais parti sur le même raisonnement et je propose la modification suivante (si les entêtes ne sont que sur la première ligne) :

Sub Macro1()
Dim dest As Range 'déclare la variable dest (DESTination)
Dim pl As Range 'déclare variable pl (PLage)
 
For x = 1 To 5 'boucle sur les 5 premiers onglets ("Lundi", Mardi", etc...)
    'définit la cellule de destination
    If Sheets("archives").Range("A3").Value = "" Then 'condition : si A3 est vide
        Set dest = Sheets("archives").Range("A3") 'dest = A3
    Else 'sinon
        'dest est la première cellule vide de la colonne A
        Set dest = Sheets("archives").Range("A65536").End(xlUp).Offset(1, 0)
    End If 'fin de la condition
    'copy toutes les cellules adjacentes à B11 et les colle dans dest
    Set pl = Sheets(x).Range("B11").CurrentRegion 'définit la plage pl
    Set pl = pl.Offset(1, 0).Resize(pl.Rows.Count - 1) 'redéfinit la plage pl en supprimant la première ligne
    pl.Copy dest 'copy la plage dans dest
Next x 'prochain onglet de la boucle
End Sub

 

[MP59]

Re : copier des données les unes à la suite des autres

Bonjour,
voir essai sur fichier en pièce jointe
MP59

 

[taty]

Re : copier des données les unes à la suite des autres

voici à quoi ressemble mon fichier
merci pour votre aide

 

[Robert]

Re : copier des données les unes à la suite des autres

Bonjour le fil, bonjour le forum,

P... ! Le mondre effort Taty. Tu aurais pu mettre quelques données !!!!
Mais bon... Si la colonne B (au passage, dans ton exemple elle est parfois la date, parfois la référence, selon l'onglet ???) est TOUJOURS éditée pour chaque ligne, le code ci-dessous devrait convenir :

Sub Macro1()
Dim dest As Range 'déclare la variable dest (DESTination)
Dim pl As Range 'déclare variable pl (PLage)
 
For x = 1 To 5 'boucle sur les 5 premiers onglets ("Lundi", Mardi", etc...)
    'définit la cellule de destination
    If Sheets("archives").Range("A3").Value = "" Then 'condition : si A3 est vide
        Set dest = Sheets("archives").Range("A3") 'dest = A3
    Else 'sinon
        'dest est la première cellule vide de la colonne A
        Set dest = Sheets("archives").Range("A65536").End(xlUp).Offset(1, 0)
    End If 'fin de la condition
    Set pl = Sheets(x).Range("B11:K" & Sheets(x).Range("B65536").End(xlUp).Row) 'définit la plage pl
    pl.Copy dest 'copy la plage dans dest
Next x 'prochain onglet de la boucle
End Sub

 

[taty]

Re : copier des données les unes à la suite des autres

Robert,
déja je te remercie pour l'aide que tu m'apporte mais si j'ai pas ajouter des info dans le tableau c'est parce que j'ai peur que cela ne puisse passer
j'ai essayé la dernière version mais elle maffiche toujours les info avec a cahque fois la reprise de l'entête
ci joint la présentation du fichier

 

[taty]

Re : copier des données les unes à la suite des autres

coucou tout le monde!!
la macro de robert marche !! j'ai pu l'adapter à mon fichier
merci ! merci! merci!
à la prochaine

 

[Robert]

Re : copier des données les unes à la suite des autres

Bonjour le fil, bonjour le forum,

Désolé Taty mais chez moi ça fontionne parfaitement. Le seul soucis, comme je te l'ai signalé plus haut, c'est que ton tableau est décalé. Il commence en colonne B dans le premier onglet et en colonne A dans les 4 autres... ?? Mais je persiste et je signe :
Si tu veux toutes les données de B11 à K... dernièle ligne éditée et que toutes les cellules de la colonne B de chaque ligne sont éditées, alors le code fonctionne.
je le recopie :

Sub Macro1()
Dim dest As Range 'déclare la variable dest (DESTination)
Dim pl As Range 'déclare variable pl (PLage)
 
For x = 1 To 5 'boucle sur les 5 premiers onglets ("Lundi", Mardi", etc...)
    'définit la cellule de destination
    If Sheets("archives").Range("A3").Value = "" Then 'condition : si A3 est vide
        Set dest = Sheets("archives").Range("A3") 'dest = A3
    Else 'sinon
        'dest est la première cellule vide de la colonne A
        Set dest = Sheets("archives").Range("A65536").End(xlUp).Offset(1, 0)
    End If 'fin de la condition
    Set pl = Sheets(x).Range("B11:K" & Sheets(x).Range("[COLOR=red][B]B[/B][/COLOR]65536").End(xlUp).Row) 'définit la plage pl
    pl.Copy dest 'copy la plage dans dest
Next x 'prochain onglet de la boucle
End Sub

Sinon, il faut que tu remplaces le B en rouge dans le code par la colonne qui est obligatoirement remplie quelle que soit la ligne.

 

[taty]

Re : copier des données les unes à la suite des autres

rebonjour à tous
j'ai ma macro qui fonctionne. cependant j'aimerais inclure un message dans la macro lui permettant d'afficher une erreur si j'exporte les mêmes informations deux fois de suite (autrement si j'exécute la macro deux fois sur les mêmes information) comment je fais?
voici la macro
Sub Macro1()
Dim dest As Range 'déclare la variable dest (DESTination)
Dim pl As Range 'déclare variable pl (PLage)

For x = 1 To 5 'boucle sur les 5 premiers onglets ("Lundi", Mardi", etc...)
'définit la cellule de destination
If Sheets("archives").Range("A3").Value = "" Then 'condition : si A3 est vide
Set dest = Sheets("archives").Range("A3") 'dest = A3
Else 'sinon
'dest est la première cellule vide de la colonne A
Set dest = Sheets("archives").Range("A65536").End(xlUp).Offset(1, 0)
End If 'fin de la condition
Set pl = Sheets(x).Range("B11:K" & Sheets(x).Range("B65536").End(xlUp).Row) 'définit la plage pl
pl.Copy dest 'copy la plage dans dest
Next x 'prochain onglet de la boucle
End Sub

 

[Robert]

Re : copier des données les unes à la suite des autres

Bonsoir le fil, bonsoir le forum,

Vérifier tous les onglets est faisable mais requiert un code beaucoup plus long. J'ai pensé que si quand tu copiais il y avait forcément des données dans l'onglet Vendredi, alors il serait plus simple de ne vérifier que les dernières lignes d'archives correspondant à Vendredi.
Le code modifié ci-dessous devrait alors convenir :

Sub Macro1()
Dim dl As Integer 'déclare la variable dl(Dernières Ligne)
Dim nl As Integer 'décare la variable nl (Nombre de Lignes)
Dim x As Integer 'déclare la variable x (incrément)
Dim dest As Range 'déclare la variable dest (DESTination)
Dim pl As Range 'déclare variable pl (PLage)
 
If Sheets("archives").Range("A3") = "" Then GoTo suite 'si A3 de l'onglet "archives" est vide va à l'étiquette "suite"
 
dl = Sheets(5).Range("B65536").End(xlUp).Row 'definit la dernière ligne éditée de l'onglet "Vendredi"
nl = dl - 11 'définit le nombre de lignes éditées dans l'onglet "Vendredi"
 
For x = 11 To dl 'boucle sur toutes les lignes éditées de l'onglet "Vendredi"
    'Condition : si la valeur de la cellule en colonne B de l'onglet "Vendredi" est différente de
    'la valeur de la cellule correspondante dans l'onglet "archives"
    If Sheets(5).Cells(x, 2).Value <> Sheets("archives").Range("A65536").End(xlUp).Offset(-nl, 0).Value Then
        GoTo suite 'va à l'étiquette suite (sans afficher le message)
    Else 'sinon
        nl = nl - 1 'redéfinit la variable nl
    End If 'fin de la condition
Next x 'prochaine cellule de la boucle
 
'si le code arrive ici c'est que toutes les cellules de la colonne B de l'onglet "Vendredi" sont identiques
'aux dernières cellules de la colonne A de l'onglet "archives"
MsgBox "Données déjà copiées !" 'message
Exit Sub 'sort de la procédure
 
suite: 'étiquette
For x = 1 To 5 'boucle sur les 5 premiers onglets ("Lundi", Mardi", etc...)
    'définit la cellule de destination
    If Sheets("archives").Range("A3").Value = "" Then 'condition : si A3 est vide
        Set dest = Sheets("archives").Range("A3") 'dest = A3
    Else 'sinon
        'dest est la première cellule vide de la colonne A
        Set dest = Sheets("archives").Range("A65536").End(xlUp).Offset(1, 0)
    End If 'fin de la condition
    Set pl = Sheets(x).Range("B11:K" & Sheets(x).Range("B65536").End(xlUp).Row) 'définit la plage pl
    pl.Copy dest 'copy la plage dans dest
Next x 'prochain onglet de la boucle
End Sub

Sinon il faudra repenser en séparant chaque copie par une ligne blanche par exemple...