Recopie alternee des 2 onglets sur un troisieme

[gwardian]

Bonjour a tous,


Je cherche le moyen de recopier les lignes de mes 2 onglets dans un 3ème onglet.
Donc dans mon 3eme onglet, j'aurais :
- la 1ere ligne de l'onglet 1
- la 1ere ligne de l'onglet 2
- la 2eme ligne de l'onglet 1
- la 2eme ligne de l'onglet 2
- la 3eme ligne de l'onglet 1
- la 3eme ligne de l'onglet 2
...

Pouvez-vous m'aider svp ?

 

[Iznogood1]

Re : Recopie alternee des 2 onglets sur un troisieme

Comme ça, vite fait :

Option Explicit

Sub demo()
  AltCopy Feuil1, Feuil2, Feuil3, 2
End Sub

Sub AltCopy(OngletSource1 As Worksheet, OngletSource2 As Worksheet, OngletDestination As Worksheet, NbCol As Integer)
  Dim i As Integer
  Dim j As Integer
    
  i = 1
  
  While OngletSource1.Range("A" & i).Value <> "" Or OngletSource2.Range("A" & i).Value <> ""
    For j = 1 To NbCol
      OngletDestination.Cells((i - 1) * 2 + 1, j).Value = OngletSource1.Cells(i, j).Value
      OngletDestination.Cells((i - 1) * 2 + 2, j).Value = OngletSource2.Cells(i, j).Value
    Next j
    i = i + 1
  Wend
End Sub

 

[gwardian]

Re : Recopie alternee des 2 onglets sur un troisieme

Bonjour Iznogood1

Merci pour ta réponse rapide.
Ton code fonctionne bien, par contre il ne prend en compte que la première cellule de la ligne au lieu de prendre en compte toute la ligne.
Aussi j'essaye de modifier ton code parce qu'en fait ma Feuil1 s'appele "Entete", ma Feuil2 s'appelle "Data" et la Feuil3 "Global".

J'essaye donc de modifier ton code pour qu'il prenne en compte toute la ligne jusqu'a la derniere cellule vide et changer le nom des feuilles.
Pour l'instant sans succès.

 

[camarchepas]

Re : Recopie alternee des 2 onglets sur un troisieme

Bonjour Iznoggof, Gwardian,

autre solution

Sub Copie()
Dim Onglet1 As Worksheet, Onglet2 As Worksheet, Onglet3 As Worksheet
Dim LigneFin1 As Long, LigneFin2 As Long, LigneFin3 As Long, Tourne As Long
Dim LigneTotales
Set Onglet1 = Worksheets("Entete")
Set Onglet2 = Worksheets("Data")
Set Onglet3 = Worksheets("Global")
LigneFin1 = Onglet1.Range("A" & Rows.Count).End(xlUp).Row
LigneFin2 = Onglet2.Range("A" & Rows.Count).End(xlUp).Row
LigneTotales = IIf(LigneFin1 > LigneFin2, LigneFin1, LigneFin2)
For Tourne = 1 To LigneTotales
LigneFin3 = Onglet3.Range("A" & Rows.Count).End(xlUp).Row
If Tourne <= LigneFin1 Then Onglet3.Range("A" & LigneFin3 + 1 & ":AZ" & LigneFin3 + 1) = Onglet1.Range("A" & Tourne & ":AZ" & Tourne).Value
LigneFin3 = Onglet3.Range("A" & Rows.Count).End(xlUp).Row
If Tourne <= LigneFin2 Then Onglet3.Range("A" & LigneFin3 + 1 & ":AZ" & LigneFin3 + 1) = Onglet2.Range("A" & Tourne & ":AZ" & Tourne).Value
Next Tourne
End Sub

 

[Iznogood1]

Re : Recopie alternee des 2 onglets sur un troisieme

Gwardian

il ne prend en compte que la première cellule de la ligne... ma Feuil1 s'appele "Entete"...

La fonction AltCopy prend 4 paramètres :

• OngletSource1 : Feuille source
• OngletSource2 : Feuille source
• OngletDestination : Feuille Destination
• NbCol : Nombre de colonnes à recopier

Ainsi dans ton cas tu peux utiliser :

AltCopy Worksheets("Entete"), Worksheets("Data"), Worksheets("Global"), 50

Recopiera 50 colonnes.
Si tu veux toute la ligne, augmente 50 à 255 ou 16384 selon ta version d'Excel.
Je recommande cependant de limiter à une largeur "raisonnable" pour éviter des traitements inutiles.

 

[gwardian]

Re : Recopie alternee des 2 onglets sur un troisieme

Bonjour,

@camarchepas
ca marche !
petite question : pourquoi la recopie dans la feuille "Global" se fait à partir de la cellule A2, et non pas A1 ?

@Iznogood1
je vais essayer


Je voudrais aller un peu plus loin en mettant une ligne sur 2 d'une couleur différente car les données sont difficiles à lire.
A cet effet, toutes les lignes de la feuille "Entete" commencent par "E" et toutes les lignes de la feuille "Data" commencent par "D". Puis je fais un filtre et j'applique une couleur sur ma plage de cellule.
Comment faire la même chose avec la macro ?
Merci a vous.

 

[Iznogood1]

Re : Recopie alternee des 2 onglets sur un troisieme

Option Explicit

Sub demo()
  AltCopy Feuil1, Feuil2, Feuil3, 2
End Sub

Sub AltCopy(OngletSource1 As Worksheet, OngletSource2 As Worksheet, OngletDestination As Worksheet, NbCol As Integer)
  Dim i As Integer
  Dim j As Integer
   
  i = 1
 
  While OngletSource1.Range("A" & i).Value <> "" Or OngletSource2.Range("A" & i).Value <> ""
    For j = 1 To NbCol
      With OngletDestination
        .Cells((i - 1) * 2 + 1, j).Value = OngletSource1.Cells(i, j).Value
        .Cells((i - 1) * 2 + 1, j).Interior.Color = RGB(200, 0, 0)
        .Cells((i - 1) * 2 + 2, j).Value = OngletSource2.Cells(i, j).Value
        .Cells((i - 1) * 2 + 1, j).Interior.Color = RGB(0, 200, 0)
      End With
    Next j
    i = i + 1
  Wend
End Sub

 

[gwardian]

Re : Recopie alternee des 2 onglets sur un troisieme

Iznogood1, merci beaucoup !
Ton code fait exactement ce que je voulais.
Désolé de ne pas avoir répondu plus tôt.

Merci encore.