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:

job75

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

Re,

Il est possible de supprimer les tableaux "vides" :

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)
Me.Names.Add "E", "EMPLACEMENTS" 'texte à adapter éventuellement
Me.Names.Add "T", "TOT" 'texte à adapter éventuellement
Application.ScreenUpdating = False
Sh.Cells.Delete 'RAZ
Set P = Sheets("EMP_WIN").UsedRange
If P.Rows.Count < 2 Then Exit Sub 'sécurité
'---filtre avancé---
Set c = P(2, P.Columns.Count + 1) 'cellule du critère
c = "=OR(COUNTIF(S,A2),A2=E,A2=T,A2=0)"
P.AdvancedFilter xlFilterInPlace, c(0).Resize(2)
With P.SpecialCells(xlCellTypeVisible).EntireRow
  n = Intersect(.Cells, P.Columns(1)).Count
  .Copy Sh.[A1]
End With
P.AdvancedFilter xlFilterInPlace, ""
c = ""
'---suppression des tableaux vides---
Set P = Sh.Cells(1, P.Columns.Count + 1).Resize(n) 'colonne auxiliaire
P.FormulaR1C1 = "=LN((RC1=E)*(R[2]C1=T)+(RC1=T)*IF(ROW()>1,OFFSET(RC1,-1,)=0)" & _
"+(RC1=0)*((R[1]C1=T)+IF(ROW()>3,OFFSET(RC1,-3,)=E)+IF(ROW()>4,OFFSET(RC1,-4,)=E)))"
On Error Resume Next 's'il n'y a rien à supprimer
P.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
P.Delete
End Sub
Fichier (4).

A+
 

Pièces jointes

  • TRANSFERT_WIN(4).xls
    120 KB · Affichages: 43
  • TRANSFERT_WIN(4).xls
    120 KB · Affichages: 38
  • TRANSFERT_WIN(4).xls
    120 KB · Affichages: 38

job75

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

Re,

Pour que les sommes correspondent aux lignes filtrées, il faut d'abord filtrer les lignes "TOT" et remplacer les fonctions SOMME par SOUS.TOTAL :

Code:
c = "=A2=T"
P.AdvancedFilter xlFilterInPlace, c(0).Resize(2)
P.SpecialCells(xlCellTypeVisible).EntireRow.Replace "SUM(", "SUBTOTAL(9,", xlPart
Ces 3 lignes peuvent ensuite être mises en commentaires car elles ne serviront plus.

Fichier (5).

A+
 

Pièces jointes

  • TRANSFERT_WIN(5).xls
    127.5 KB · Affichages: 39
  • TRANSFERT_WIN(5).xls
    127.5 KB · Affichages: 44
  • TRANSFERT_WIN(5).xls
    127.5 KB · Affichages: 36

ABDELHAK

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

Bonjour job75,

Je suis désolé d’avoir mis du temps à vous répondre, j’ai eu des soucis avec ma boite mail depuis que mon ordinateur est infecté par le virus Surabaya.
J’ai en effet eu beaucoup de mal à me connecté avec le forum.
De toute façon, merci d’avoir 1 fois de plus prêter attention à mon projet, hélas sans résultat.
Mais la raison en est simple, je vous ai très mal exposé mon projet.
Je vous demande humblement d’y jeter un tout dernier coup d’œil, si vous voulez.
En tout cas, merci pour tout ce que vous faîtes.

A bientôt je l’espère.

Amicalement vôtre

ABDELHAK



POUR CHAQUES REF SE TROUVANT SUR LES LIGNES 1, 2 et 3 DE SHEET (EMP_PROP) CHERCHER ( PAR LIGNE ET PAR REF ) DANS LA COLONNE A DE SHEET (EMP_WIN) LES REF CORRESPONDANTES.
ENSUITE PARCOURIR TOUTE LA FEUILLE COMPOSEE DE 29 SERIES ( 1 SERIE = 592 LIGNES ) AU TOTAL 17165 LIGNES. ENSUITE EXECUTER UN COPIER/COLLER VERS SHEET (1) POUR LES REF CORRESPONDANTES A LA LIGNE 1, VERS SHEET (2) POUR LES REF CORRESPONDANTES A LA LIGNE 2, … , VERS SHEET (200) POUR LES REF CORRESPONDANTES A LA LIGNE 200.

PROCEDURE POUR LA LIGNE 1 DE SHEET(EMP_PROP)

1ière SERIE DANS SHEET(EMP_WIN) DE LA LIGNE 1 à 589

1) FAIRE UN COPIER/COLLER DES LIGNES 1 ET 2 DE SHEET(EMP_WIN) VERS SHEET(1)
2) CHERCHER "AG1" DANS LA COLONNE A DES LIGNES 1 à 588 DE SHEET(EMP_WIN)
3) FAIRE UN COPIER/COLLER DE TOUTE LA LIGNE VERS SHEET(1)
4) LIGNE 1 : "AH1", "AK1", "AN1", "AQ1", "AW1", "AY1", "BB1", "BE1", "BQ1" APPLIQUER LA MEME PROCEDURE CITE EN 2) ET 3)
5) COPIER/COLLER LA LIGNE 589 {SOMMES DES COLONNES B à HX (B3:B588), (C3:C588), …, (HX3:HX588).} DE SHEET(EMP_WIN) VERS SHEET(1)

2ième SERIE DANS SHEET(EMP_WIN) DE LA LIGNE 593 à 1181

1) FAIRE UN COPIER/COLLER DES LIGNES 593 ET 594 DE SHEET(EMP_WIN) VERS SHEET(1)
2) CHERCHER "AG1" DANS LA COLONNE A DE LA LIGNE 595 à 1180 DE SHEET(EMP_WIN)
3) FAIRE UN COPIER/COLLER DE TOUTE LA LIGNE VERS SHEET(1)
4) LIGNE 1 : "AH1", "AK1", "AN1", "AQ1", "AW1", "AY1", "BB1", "BE1", "BQ1" APPLIQUER LA MEME PROCEDURE CITE EN 2) ET 3)
5) COPIER/COLLER LA LIGNE 1181 {SOMMES DES COLONNES B à HX (B595:B1180), (C595:C1180), …, (HX595:HX1180).} DE SHEET(EMP_WIN) VERS SHEET(1)

ET AINSI DE SUITE POUR LA LIGNE 1, IL Y A AU TOTAL 29 SERIES DANS SHEET(EMP_WIN) ET 17165 LIGNES (1 SERIE = 592 LIGNES)
COPIER / COLLER LES LIGNES ENTIERES DES REF CORRESPONDANTES A LA LIGNE 1 VERS SHEET(1)

POUR LES 200 LIGNES DE SHEET (EMP_PROP) APPLIQUER LA MEME PROCEDURE QUE LA LIGNE 1 DE SHEET (EMP_PROP)
 

Pièces jointes

  • ELAB_TRANSFERT_WIN - Copie.xls
    188.5 KB · Affichages: 47
  • ELAB_TRANSFERT_WIN - Copie.xls
    188.5 KB · Affichages: 46
  • ELAB_TRANSFERT_WIN - Copie.xls
    188.5 KB · Affichages: 46

ABDELHAK

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

Bonjour job75,

Je suis désolé d’avoir mis du temps à vous répondre, j’ai eu des soucis avec ma boite mail depuis que mon ordinateur est infecté par le virus Surabaya.
J’ai en effet eu beaucoup de mal à me connecté avec le forum.
De toute façon, merci d’avoir 1 fois de plus prêté attention à mon projet, hélas sans résultats.
Mais la raison en est simple, je vous ai très mal exposé mon projet.
Je vous demande humblement d’y jeter un tout dernier coup d’œil, si vous voulez.
Je suis presque arrivé au bout de mon projet et tout cela grâce à vous.
En tout cas, merci pour tout ce que vous avez fait.

A bientôt je l’espère.

Amicalement vôtre

ABDELHAK



POUR CHAQUES REF SE TROUVANT SUR LES LIGNES 1, 2 et 3 DE SHEET (EMP_PROP) CHERCHER ( PAR LIGNE ET PAR REF ) DANS LA COLONNE A DE SHEET (EMP_WIN) LES REF CORRESPONDANTES.
ENSUITE PARCOURIR TOUTE LA FEUILLE COMPOSEE DE 29 SERIES ( 1 SERIE = 592 LIGNES ) AU TOTAL 17165 LIGNES. ENSUITE EXECUTER UN COPIER/COLLER VERS SHEET (1) POUR LES REF CORRESPONDANTES A LA LIGNE 1, VERS SHEET (2) POUR LES REF CORRESPONDANTES A LA LIGNE 2, … , VERS SHEET (200) POUR LES REF CORRESPONDANTES A LA LIGNE 200.

PROCEDURE POUR LA LIGNE 1 DE SHEET(EMP_PROP)

1ière SERIE DANS SHEET(EMP_WIN) DE LA LIGNE 1 à 589

1) FAIRE UN COPIER/COLLER DES LIGNES 1 ET 2 DE SHEET(EMP_WIN) VERS SHEET(1)
2) CHERCHER "AG1" DANS LA COLONNE A DES LIGNES 1 à 588 DE SHEET(EMP_WIN)
3) FAIRE UN COPIER/COLLER DE TOUTE LA LIGNE VERS SHEET(1)
4) LIGNE 1 : "AH1", "AK1", "AN1", "AQ1", "AW1", "AY1", "BB1", "BE1", "BQ1" APPLIQUER LA MEME PROCEDURE CITE EN 2) ET 3)
5) COPIER/COLLER LA LIGNE 589 {SOMMES DES COLONNES B à HX (B3:B588), (C3:C588), …, (HX3:HX588).} DE SHEET(EMP_WIN) VERS SHEET(1)

2ième SERIE DANS SHEET(EMP_WIN) DE LA LIGNE 593 à 1181

1) FAIRE UN COPIER/COLLER DES LIGNES 593 ET 594 DE SHEET(EMP_WIN) VERS SHEET(1)
2) CHERCHER "AG1" DANS LA COLONNE A DE LA LIGNE 595 à 1180 DE SHEET(EMP_WIN)
3) FAIRE UN COPIER/COLLER DE TOUTE LA LIGNE VERS SHEET(1)
4) LIGNE 1 : "AH1", "AK1", "AN1", "AQ1", "AW1", "AY1", "BB1", "BE1", "BQ1" APPLIQUER LA MEME PROCEDURE CITE EN 2) ET 3)
5) COPIER/COLLER LA LIGNE 1181 {SOMMES DES COLONNES B à HX (B595:B1180), (C595:C1180), …, (HX595:HX1180).} DE SHEET(EMP_WIN) VERS SHEET(1)

ET AINSI DE SUITE POUR LA LIGNE 1, IL Y A AU TOTAL 29 SERIES DANS SHEET(EMP_WIN) ET 17165 LIGNES (1 SERIE = 592 LIGNES)
COPIER / COLLER LES LIGNES ENTIERES DES REF CORRESPONDANTES A LA LIGNE 1 VERS SHEET(1)

POUR LES 200 LIGNES DE SHEET (EMP_PROP) APPLIQUER LA MEME PROCEDURE QUE LA LIGNE 1 DE SHEET (EMP_PROP)
IL N’Y A PAS DE TABLEAU VIDE.
 

Pièces jointes

  • ELAB_TRANSFERT_WIN - Copie.xls
    188.5 KB · Affichages: 41
  • ELAB_TRANSFERT_WIN - Copie.xls
    188.5 KB · Affichages: 43
  • ELAB_TRANSFERT_WIN - Copie.xls
    188.5 KB · Affichages: 34

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16