Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

ABDELHAK

XLDnaute Occasionnel
Bonjour à tous ,

Merci d’avance pour l’attention que vous accorderez a ma demande, je suis presque arrivé au bout de mon projet et cela grâce à vous.

Voici donc ma requête :

J’ai un fichier de 205 feuilles

En feuil1(EMP_WIN), il y a plusieurs tableaux.
Ces tableaux se composent comme suit :
La première ligne = dates
La deuxième ligne = facultatif
De la 3ième à la 588ième lignes = valeurs (A1, B1, C1, …, HO1) + des chiffres 1 sur fond vert
589ième ligne = la somme des colonnes B à HX des lignes 3 à 588
Et il y a plusieurs tableaux du même type sur toute la feuille (de la ligne 1 à la ligne 17167)

En feuil2(EMP_PROP), il y a 200 lignes avec 10 valeurs par ligne (A1, B1, C1, …, HO1)

De la Feuil3 à la feuil202 (1, 2 , 3, …, 200)

But de la macro

1) aller à la ligne 1 de la feuil2 (EMP_PROP)
2) lire les 10 ref (A1, B1, C1, …, HO1)
3) chercher à la feuil1(EMP_WIN) les ref (A1, B1, C1, …, HO1) correspondant et qui se trouvent dans la colonne A
4) exécuter un copier/coller de la ligne entière vers SHEET1
1) ligne 1 = dates
2) ligne 2 = facultatif
3) les ref (A1, B1, C1, …, HO1) correspondant
4) ligne 588 contenant les sommes
5) et ainsi de suite
5) aller à la ligne 2 de la (EMP_PROP)
6) exécuter la même procédure vers SHEET2

Je joins un fichier qui vous aidera à mieux comprendre ma requête, du moins, c’est mon souhait.

En espérant avoir été complet, je vous remercie d’avance pour l’attention que vous y accorderai.

Amicalement vôtre,

Abdelhak
 

Pièces jointes

  • TRANSFERT_WIN.xls
    252.5 KB · Affichages: 53
  • TRANSFERT_WIN.xls
    252.5 KB · Affichages: 62
  • TRANSFERT_WIN.xls
    252.5 KB · Affichages: 64
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

Re

ABDELHAK
Faire un up: c'est se répondre à soi-même dans sa propre discussion,ce qui a pour effet de remonter la discussion en tête de liste (d'où le nom: faire un up)

On peut en profiter pour ajouter des explications et des détails si les réponses tardent à venir.

(En tout cas, cela vaut mieux que de récréer plusieurs discussions pour la même question)

Donc, normalement, il faudrait à l'avenir que tu fasses des up dans cette discussion
(puisque j'ai commencé à te répondre dans celle-ci) et non plus dans la première)

En tout cas, tu sauras désormais faire un up quand tu créeras une nouvelle discussion pour un nouveau problème.
 

Staple1600

XLDnaute Barbatruc
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

Re

Plusieurs des étapes de ta question peuvent être obtenu en laissant tourner l’enregistreur de macros...
exemple pour 1)
Sub Macro1()
Sheets("EMP_PROP").Select
Rows("1:1").Select
End Sub

Au fait et dans cet autre fil, c'est plus ou moins la même question, non ?
https://www.excel-downloads.com/threads/copier-coller-colonnes-de-ieurs-tableaux.218954/
Et l'ami job75 t'a faconné (comme à son habitude) du bel ouvrage ;)
 
Dernière édition:

ABDELHAK

XLDnaute Occasionnel
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

bonjour jm

en effet notre job75 m'a façonné le top du top, et à plusieurs reprises. je lui serai reconnaissant à vie.
en ce qui concerne ma dernière demande ce n'est pas tout à fait la même chose....

dans tous les cas merci à vous tous
 

job75

XLDnaute Barbatruc
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

Bonjour ABDELHAK, Jean-Marie,

Voyez cette macro dans le ThisWorkbook du fichier joint :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsNumeric(Sh.Name) Then Exit Sub
Dim ts, t, ub&, i&, j As Byte, P As Range, n&
ts = Sheets("EMP_PROP").Range("B" & Sh.Name).Resize(, 10)
With Sheets("EMP_WIN")
  t = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)(2))
  ub = UBound(t)
  For i = 1 To ub Step 15
    If i + 10 >= ub Then Exit For 'sécurité
    For j = 1 To 10
      If t(i + j + 1, 1) <> ts(1, j) Then GoTo 1
    Next
    Set P = Union(.Rows(i).Resize(15), IIf(P Is Nothing, .Rows(i).Resize(15), P))
    n = n + 1
1 Next
End With
If n Then P.Copy Sh.[A1]
Sh.Rows(15 * n + 1 & ":" & Sh.Rows.Count).Delete
End Sub
La macro s'exécute quand l'une des feuilles 1 2 3 est activée.

Nota : votre fichier n'était guère fameux pour tester puisque toutes les séries de 10 étaient identiques !!!

Dans mon fichier il y a 3 types de séries différentes.

Edit : j'ai ajouté (2) en 6ème ligne du code pour le cas (improbable) ou la feuille EMP_WIN serait vide...

A+
 

Pièces jointes

  • TRANSFERT_WIN(1).xls
    119.5 KB · Affichages: 55
  • TRANSFERT_WIN(1).xls
    119.5 KB · Affichages: 64
  • TRANSFERT_WIN(1).xls
    119.5 KB · Affichages: 63
Dernière édition:

job75

XLDnaute Barbatruc
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

Re,

Ceci est mieux, on évite le test de sécurité :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsNumeric(Sh.Name) Then Exit Sub
Dim ts, t, i&, j As Byte, P As Range, n&
ts = Sheets("EMP_PROP").Range("B" & Sh.Name).Resize(, 10)
With Sheets("EMP_WIN")
  t = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)(2))
  For i = 1 To UBound(t) - 11 Step 15 '-11 en cas de dernier tableau incomplet
    For j = 1 To 10
      If t(i + j + 1, 1) <> ts(1, j) Then GoTo 1
    Next
    Set P = Union(.Rows(i).Resize(15), IIf(P Is Nothing, .Rows(i).Resize(15), P))
    n = n + 1
1 Next
End With
If n Then P.Copy Sh.[A1]
Sh.Rows(15 * n + 1 & ":" & Sh.Rows.Count).Delete
End Sub
Fichier (2).

A+
 

Pièces jointes

  • TRANSFERT_WIN(2).xls
    119 KB · Affichages: 49
  • TRANSFERT_WIN(2).xls
    119 KB · Affichages: 49
  • TRANSFERT_WIN(2).xls
    119 KB · Affichages: 37

job75

XLDnaute Barbatruc
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

Re,

Avec les fichiers précédents, chaque tableau est copié si la série de la feuille EMP_PROP est trouvée dans le bon ordre.

Avec ce fichier (2 bis) l'ordre n'a plus d'importance, il suffit que tous les éléments soient trouvés :

Code:
Option Compare Text 'la casse est ignorée (facultatif)

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsNumeric(Sh.Name) Then Exit Sub
Dim ts, t, i&, j As Byte, x$, k As Byte, P As Range, n&
ts = Sheets("EMP_PROP").Range("B" & Sh.Name).Resize(, 10)
With Sheets("EMP_WIN")
  t = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)(2))
  For i = 1 To UBound(t) - 11 Step 15 '-11 en cas de dernier tableau incomplet
    For j = 1 To 10
      x = t(i + j + 1, 1)
      For k = 1 To 10
        If x = ts(1, k) Then Exit For
      Next
      If k = 11 Then GoTo 1
    Next
    Set P = Union(.Rows(i).Resize(15), IIf(P Is Nothing, .Rows(i).Resize(15), P))
    n = n + 1
1 Next
End With
If n Then P.Copy Sh.[A1]
Sh.Rows(15 * n + 1 & ":" & Sh.Rows.Count).Delete
End Sub
Avec une boucle supplémentaire l'exécution est bien sûr bien moins rapide.

Nota : j'ai ajouté Option Compare Text si l'on veut ignorer la casse dans les comparaisons.

A+
 

Pièces jointes

  • TRANSFERT_WIN(2 bis).xls
    119 KB · Affichages: 53
Dernière édition:

job75

XLDnaute Barbatruc
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

Re,

Il y a un truc que je n'ai pas compris dans votre post #1 c'est l'histoire de la ligne 588.

Je n'en ai pas tenu compte dans mes solutions, tous les tableaux ayant 14 lignes.

A+
 

ABDELHAK

XLDnaute Occasionnel
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

re bonjour job75

en fait les séries de tableaux réelles se composent comme suit :

L1 = dates
L2 = facultatif
L3 à L588 = valeurs(A1, B1,..., FC1) + chiffre 1 sur fond vert (L588 correspond à l'avant-dernière ligne de la 1ière série et à la ligne 12 feuil1(EMP_WIN) du fichier que vous m'avez envoyé)
L589 = sommes des colonnes B à HX et des lignes 3 à 588
L1 à L589 = 1ière série
L593 à L1181 = 2ième série
L1777 à L2365 = 3ième série
et ainsi de suite
L16577 à L17165 = dernière série

en espérant avoir bien répondu à votre question

merci

amicalement vôtre

ABDELHAK
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

Re,

Sur la feuille EMP_PROP les séries ont 10 éléments...

Je n'irai donc pas plus loin, désolé, il fallait poser le problème clairement.

A+
 

ABDELHAK

XLDnaute Occasionnel
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

re bonjour job75,

Je pense qu'on ne s'est pas compris. La grande difficulté est évidemment de bien présenter le problème, et ce n'est pas toujours aisé. Cette fois-ci c'est à moitié dans l'eau. J'espère que pour la prochaine fois ce sera mieux, si vous le voulez.
En tout cas, je vous suis reconnaissant pour tout ce que vous avez fait pour moi, c'est tout simplement géant.
Je ne le répèterai jamais assez, j'ai un immense respect pour votre personne et ce que vous faites.
Je le pense sincèrement.
De plus avec ce que vous m'avez envoyé aujourd'hui, j'ai du pain sur la planche.

Amicalement vôtre

ABDELHAK
 

job75

XLDnaute Barbatruc
Re : Copier / coller ligne entiere sur plusieurs feuilles a partir d une feuille

Bonjour ABDELHAK, le forum,

Ne sachant toujours pas ce que vous voulez faire avec les séries de la feuille EMP_PROP, une dernière tentative :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not IsNumeric(Sh.Name) Then Exit Sub
Dim P As Range, c As Range, n&
Me.Names.Add "S", Sheets("EMP_PROP").Range("B" & Sh.Name).Resize(, 10)
Set P = Sheets("EMP_WIN").UsedRange
Set c = P(2, P.Columns.Count + 1) 'cellule du critère
c = "=OR(COUNTIF(S,A2),A2=""EMPLACEMENTS"",A2=""TOT"",A2="""")"
P.AdvancedFilter xlFilterInPlace, c(0).Resize(2)
With P.SpecialCells(xlCellTypeVisible).EntireRow
  n = Intersect(.Cells, P.Columns(1)).Count
  .Copy Sh.[A1]
End With
Sh.Rows(n + 1 & ":" & Sh.Rows.Count).Delete
P.AdvancedFilter xlFilterInPlace, ""
c = ""
End Sub
La macro utilise un filtre élaboré (avancé).

Fichier (3).

Vous allez peut-être arriver à vous exprimer :rolleyes:

A+
 

Pièces jointes

  • TRANSFERT_WIN(3).xls
    119 KB · Affichages: 53
  • TRANSFERT_WIN(3).xls
    119 KB · Affichages: 51
  • TRANSFERT_WIN(3).xls
    119 KB · Affichages: 61
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 925
Membres
101 841
dernier inscrit
ferid87