fusion de plusieurs feuilles en VBA

Le
marcus
Bonjour à vous tous
Voici mon problème. J'ai quatre feuilles.
Feuille 1, Feuille 2, Feuille 3 et Sommaire.
Chacune des feuilles contient le même texte placé au même endroit, tout ce
qui change, c'est un tableau avec le nom des employés qui commence avec les
en-têtes à la cellule A34 jusqu'à la colonne R47. Ce que je veux faire, c'est
de prendre le tableau des noms de chaque feuille et d'avoir tout les données
dans la feuille sommaire. J,ai une macro, mais elle commence à la ligne A34
mais jusqu'à la fin de la feuille (A65536), moi je veux qu'elle arrête à la
ligne 47.


Voici mon code

Sub un_test()

Worksheets("sommaire").Range("a1").CurrentRegion.ClearContents
Dim c As Range, PlageRecap As Range, Plage As Range
Dim Ligne As Long
Sheets("sommaire").Select
Set PlageRecap = Range("A1", Range("A65536").End(xlUp))
Ligne = PlageRecap.Rows.Count
Sheets("feuille 1").Select
Set Plage = Range("A34", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 2").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 3").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
End Sub

En espérant que le tout est assez claire

Merci de votre aide
Marc
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
LSteph
Le #4985751
Bonjour,

Attention, si tu utilises ainsi le .name des feuilles
aux noms qui pourraient varier "Sommaire" ou "sommaire"
"Feuil2" ou "feuille 2"

Sub test()
Dim i&
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For i = 1 To 3
With Worksheets("feuille " & i)
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End With
Next i
Worksheets("sommaire").Activate
End Sub

'lSteph

Bonjour à vous tous
Voici mon problème. J'ai quatre feuilles.
Feuille 1, Feuille 2, Feuille 3 et Sommaire.
Chacune des feuilles contient le même texte placé au même endroit, tout ce
qui change, c'est un tableau avec le nom des employés qui commence avec les
en-têtes à la cellule A34 jusqu'à la colonne R47. Ce que je veux faire, c'est
de prendre le tableau des noms de chaque feuille et d'avoir tout les données
dans la feuille sommaire. J,ai une macro, mais elle commence à la ligne A34
mais jusqu'à la fin de la feuille (A65536), moi je veux qu'elle arrête à la
ligne 47.


Voici mon code

Sub un_test()

Worksheets("sommaire").Range("a1").CurrentRegion.ClearContents
Dim c As Range, PlageRecap As Range, Plage As Range
Dim Ligne As Long
Sheets("sommaire").Select
Set PlageRecap = Range("A1", Range("A65536").End(xlUp))
Ligne = PlageRecap.Rows.Count
Sheets("feuille 1").Select
Set Plage = Range("A34", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 2").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 3").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
End Sub

En espérant que le tout est assez claire

Merci de votre aide
Marc



marcus
Le #4985631
Bonjour LSteph
Merci de ta réponse rapide. Par contre, juste une petite chose, dans mon
vrai fichier, les feuilles portent des vrais noms.
Exemple
Feuille 1= France
Feuille 2=USA
Feuille 3=Suisse
Comment modifier le code alors? Désolé de ne pas avoir préciser ce détail
lors de mon premier post.

Merci de ton aide

Marcus


Bonjour,

Attention, si tu utilises ainsi le .name des feuilles
aux noms qui pourraient varier "Sommaire" ou "sommaire"
"Feuil2" ou "feuille 2"

Sub test()
Dim i&
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For i = 1 To 3
With Worksheets("feuille " & i)
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End With
Next i
Worksheets("sommaire").Activate
End Sub

'lSteph

Bonjour à vous tous
Voici mon problème. J'ai quatre feuilles.
Feuille 1, Feuille 2, Feuille 3 et Sommaire.
Chacune des feuilles contient le même texte placé au même endroit, tout ce
qui change, c'est un tableau avec le nom des employés qui commence avec les
en-têtes à la cellule A34 jusqu'à la colonne R47. Ce que je veux faire, c'est
de prendre le tableau des noms de chaque feuille et d'avoir tout les données
dans la feuille sommaire. J,ai une macro, mais elle commence à la ligne A34
mais jusqu'à la fin de la feuille (A65536), moi je veux qu'elle arrête à la
ligne 47.


Voici mon code

Sub un_test()

Worksheets("sommaire").Range("a1").CurrentRegion.ClearContents
Dim c As Range, PlageRecap As Range, Plage As Range
Dim Ligne As Long
Sheets("sommaire").Select
Set PlageRecap = Range("A1", Range("A65536").End(xlUp))
Ligne = PlageRecap.Rows.Count
Sheets("feuille 1").Select
Set Plage = Range("A34", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 2").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 3").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
End Sub

En espérant que le tout est assez claire

Merci de votre aide
Marc






lSteph
Le #4985621
Sub test()
Dim sh As Worksheet
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For Each sh In ActiveWorkbook.Worksheets
With sh
Select Case .Name
Case "France", "USA", "Suisse"

.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues

End Select
End With
Next sh
Worksheets("sommaire").Activate
End Sub

--
lSteph



On 17 oct, 11:57, marcus
Bonjour LSteph
Merci de ta réponse rapide. Par contre, juste une petite chose, dans mon
vrai fichier, les feuilles portent des vrais noms.
Exemple
Feuille 1= France
Feuille 2=USA
Feuille 3=Suisse
Comment modifier le code alors? Désolé de ne pas avoir préciser ce détail
lors de mon premier post.

Merci de ton aide

Marcus


Bonjour,

Attention, si tu utilises ainsi le .name des feuilles
aux noms qui pourraient varier "Sommaire" ou "sommaire"
"Feuil2" ou "feuille 2"

Sub test()
Dim i&
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For i = 1 To 3
With Worksheets("feuille " & i)
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End With
Next i
Worksheets("sommaire").Activate
End Sub

'lSteph

Bonjour à vous tous
Voici mon problème. J'ai quatre feuilles.
Feuille 1, Feuille 2, Feuille 3 et Sommaire.
Chacune des feuilles contient le même texte placé au même endro it, tout ce
qui change, c'est un tableau avec le nom des employés qui commence avec les
en-têtes à la cellule A34 jusqu'à la colonne R47. Ce que je veu x faire, c'est
de prendre le tableau des noms de chaque feuille et d'avoir tout les données
dans la feuille sommaire. J,ai une macro, mais elle commence à la l igne A34
mais jusqu'à la fin de la feuille (A65536), moi je veux qu'elle arr ête à la
ligne 47.

Voici mon code

Sub un_test()

Worksheets("sommaire").Range("a1").CurrentRegion.ClearContents
Dim c As Range, PlageRecap As Range, Plage As Range
Dim Ligne As Long
Sheets("sommaire").Select
Set PlageRecap = Range("A1", Range("A65536").End(xlUp))
Ligne = PlageRecap.Rows.Count
Sheets("feuille 1").Select
Set Plage = Range("A34", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 2").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 3").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
End Sub

En espérant que le tout est assez claire

Merci de votre aide
Marc






marcus
Le #4985031
Bonjour lSteph
Merci énormément de ton aide

Merci et bonne journée

Marc


Sub test()
Dim sh As Worksheet
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For Each sh In ActiveWorkbook.Worksheets
With sh
Select Case .Name
Case "France", "USA", "Suisse"

.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues

End Select
End With
Next sh
Worksheets("sommaire").Activate
End Sub

--
lSteph



On 17 oct, 11:57, marcus
Bonjour LSteph
Merci de ta réponse rapide. Par contre, juste une petite chose, dans mon
vrai fichier, les feuilles portent des vrais noms.
Exemple
Feuille 1= France
Feuille 2=USA
Feuille 3=Suisse
Comment modifier le code alors? Désolé de ne pas avoir préciser ce détail
lors de mon premier post.

Merci de ton aide

Marcus


Bonjour,

Attention, si tu utilises ainsi le .name des feuilles
aux noms qui pourraient varier "Sommaire" ou "sommaire"
"Feuil2" ou "feuille 2"

Sub test()
Dim i&
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For i = 1 To 3
With Worksheets("feuille " & i)
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End With
Next i
Worksheets("sommaire").Activate
End Sub

'lSteph

Bonjour à vous tous
Voici mon problème. J'ai quatre feuilles.
Feuille 1, Feuille 2, Feuille 3 et Sommaire.
Chacune des feuilles contient le même texte placé au même endroit, tout ce
qui change, c'est un tableau avec le nom des employés qui commence avec les
en-têtes à la cellule A34 jusqu'à la colonne R47. Ce que je veux faire, c'est
de prendre le tableau des noms de chaque feuille et d'avoir tout les données
dans la feuille sommaire. J,ai une macro, mais elle commence à la ligne A34
mais jusqu'à la fin de la feuille (A65536), moi je veux qu'elle arrête à la
ligne 47.

Voici mon code

Sub un_test()

Worksheets("sommaire").Range("a1").CurrentRegion.ClearContents
Dim c As Range, PlageRecap As Range, Plage As Range
Dim Ligne As Long
Sheets("sommaire").Select
Set PlageRecap = Range("A1", Range("A65536").End(xlUp))
Ligne = PlageRecap.Rows.Count
Sheets("feuille 1").Select
Set Plage = Range("A34", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 2").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 3").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
End Sub

En espérant que le tout est assez claire

Merci de votre aide
Marc











marcus
Le #4984801
Bonjour LSteph
J'ai juste une dernière petite chose. Su chacune des pages, les lignes 34 à
36 contiennent les en-têtes. Le problème, c'est que la macro recopie les
en-têtes de chacune des pages. Comment lui dire de commencer à la ligne 34
pour la feuille France, mais à la ligne 37 pour les feuilles USA et Suisse.

merci encore de ton aide

marcus


Sub test()
Dim sh As Worksheet
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For Each sh In ActiveWorkbook.Worksheets
With sh
Select Case .Name
Case "France", "USA", "Suisse"

.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues

End Select
End With
Next sh
Worksheets("sommaire").Activate
End Sub

--
lSteph



On 17 oct, 11:57, marcus
Bonjour LSteph
Merci de ta réponse rapide. Par contre, juste une petite chose, dans mon
vrai fichier, les feuilles portent des vrais noms.
Exemple
Feuille 1= France
Feuille 2=USA
Feuille 3=Suisse
Comment modifier le code alors? Désolé de ne pas avoir préciser ce détail
lors de mon premier post.

Merci de ton aide

Marcus


Bonjour,

Attention, si tu utilises ainsi le .name des feuilles
aux noms qui pourraient varier "Sommaire" ou "sommaire"
"Feuil2" ou "feuille 2"

Sub test()
Dim i&
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For i = 1 To 3
With Worksheets("feuille " & i)
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End With
Next i
Worksheets("sommaire").Activate
End Sub

'lSteph

Bonjour à vous tous
Voici mon problème. J'ai quatre feuilles.
Feuille 1, Feuille 2, Feuille 3 et Sommaire.
Chacune des feuilles contient le même texte placé au même endroit, tout ce
qui change, c'est un tableau avec le nom des employés qui commence avec les
en-têtes à la cellule A34 jusqu'à la colonne R47. Ce que je veux faire, c'est
de prendre le tableau des noms de chaque feuille et d'avoir tout les données
dans la feuille sommaire. J,ai une macro, mais elle commence à la ligne A34
mais jusqu'à la fin de la feuille (A65536), moi je veux qu'elle arrête à la
ligne 47.

Voici mon code

Sub un_test()

Worksheets("sommaire").Range("a1").CurrentRegion.ClearContents
Dim c As Range, PlageRecap As Range, Plage As Range
Dim Ligne As Long
Sheets("sommaire").Select
Set PlageRecap = Range("A1", Range("A65536").End(xlUp))
Ligne = PlageRecap.Rows.Count
Sheets("feuille 1").Select
Set Plage = Range("A34", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 2").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 3").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
End Sub

En espérant que le tout est assez claire

Merci de votre aide
Marc











LSteph
Le #4984751
Bonjour Marcus,


Modifie le select case
Tu peux aussi ajouter des conditions et ainsi des noms de feuilles


Ce qui est actuellement ici:
'...
Select Case .Name
Case "France", "USA", "Suisse"
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End Select
'...

Pourrait s'adapter selon
... commencer .. ligne 34 pour...France,..ligne >37.. USA et Suisse.


'...
Select Case .Name
Case "France"
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
Case "USA", "Suisse"
.[a37:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End Select
'...

Mais cela suppose que les en-têtes sont identiques et surtout que la
feuille France soit toujours celle traitée en premier lieu, sinon les
en-têtes se retrouvent au milieu du récapitulatif.
Donc autre solution, mettre d'avance tes en-têtes dans la feuille
sommaire et traiter tout depuis ligne 37.

Cordialement.

--
lSteph

Bonjour LSteph
J'ai juste une dernière petite chose. Su chacune des pages, les lignes 34 à
36 contiennent les en-têtes. Le problème, c'est que la macro recopie les
en-têtes de chacune des pages. Comment lui dire de commencer à la ligne 34
pour la feuille France, mais à la ligne 37 pour les feuilles USA et Suisse.

merci encore de ton aide

marcus


Sub test()
Dim sh As Worksheet
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For Each sh In ActiveWorkbook.Worksheets
With sh
Select Case .Name
Case "France", "USA", "Suisse"

.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues

End Select
End With
Next sh
Worksheets("sommaire").Activate
End Sub

--
lSteph



On 17 oct, 11:57, marcus
Bonjour LSteph
Merci de ta réponse rapide. Par contre, juste une petite chose, dans mon
vrai fichier, les feuilles portent des vrais noms.
Exemple
Feuille 1= France
Feuille 2=USA
Feuille 3=Suisse
Comment modifier le code alors? Désolé de ne pas avoir préciser ce détail
lors de mon premier post.

Merci de ton aide

Marcus


Bonjour,
Attention, si tu utilises ainsi le .name des feuilles
aux noms qui pourraient varier "Sommaire" ou "sommaire"
"Feuil2" ou "feuille 2"
Sub test()
Dim i&
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For i = 1 To 3
With Worksheets("feuille " & i)
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End With
Next i
Worksheets("sommaire").Activate
End Sub
'lSteph
Bonjour à vous tous
Voici mon problème. J'ai quatre feuilles.
Feuille 1, Feuille 2, Feuille 3 et Sommaire.
Chacune des feuilles contient le même texte placé au même endroit, tout ce
qui change, c'est un tableau avec le nom des employés qui commence avec les
en-têtes à la cellule A34 jusqu'à la colonne R47. Ce que je veux faire, c'est
de prendre le tableau des noms de chaque feuille et d'avoir tout les données
dans la feuille sommaire. J,ai une macro, mais elle commence à la ligne A34
mais jusqu'à la fin de la feuille (A65536), moi je veux qu'elle arrête à la
ligne 47.
Voici mon code
Sub un_test()
Worksheets("sommaire").Range("a1").CurrentRegion.ClearContents
Dim c As Range, PlageRecap As Range, Plage As Range
Dim Ligne As Long
Sheets("sommaire").Select
Set PlageRecap = Range("A1", Range("A65536").End(xlUp))
Ligne = PlageRecap.Rows.Count
Sheets("feuille 1").Select
Set Plage = Range("A34", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 2").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 3").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
End Sub
En espérant que le tout est assez claire
Merci de votre aide
Marc












marcus
Le #4984371
Bonjour LSeph
Un gros merci pour ton aide, ce fût très apprécié

Merci encore une fois et bonne journée

marc


Bonjour Marcus,


Modifie le select case
Tu peux aussi ajouter des conditions et ainsi des noms de feuilles


Ce qui est actuellement ici:
'...
Select Case .Name
Case "France", "USA", "Suisse"
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End Select
'...

Pourrait s'adapter selon
... commencer .. ligne 34 pour...France,..ligne >37.. USA et Suisse.


'...
Select Case .Name
Case "France"
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
Case "USA", "Suisse"
.[a37:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End Select
'...

Mais cela suppose que les en-têtes sont identiques et surtout que la
feuille France soit toujours celle traitée en premier lieu, sinon les
en-têtes se retrouvent au milieu du récapitulatif.
Donc autre solution, mettre d'avance tes en-têtes dans la feuille
sommaire et traiter tout depuis ligne 37.

Cordialement.

--
lSteph

Bonjour LSteph
J'ai juste une dernière petite chose. Su chacune des pages, les lignes 34 à
36 contiennent les en-têtes. Le problème, c'est que la macro recopie les
en-têtes de chacune des pages. Comment lui dire de commencer à la ligne 34
pour la feuille France, mais à la ligne 37 pour les feuilles USA et Suisse.

merci encore de ton aide

marcus


Sub test()
Dim sh As Worksheet
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For Each sh In ActiveWorkbook.Worksheets
With sh
Select Case .Name
Case "France", "USA", "Suisse"

.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues

End Select
End With
Next sh
Worksheets("sommaire").Activate
End Sub

--
lSteph



On 17 oct, 11:57, marcus
Bonjour LSteph
Merci de ta réponse rapide. Par contre, juste une petite chose, dans mon
vrai fichier, les feuilles portent des vrais noms.
Exemple
Feuille 1= France
Feuille 2=USA
Feuille 3=Suisse
Comment modifier le code alors? Désolé de ne pas avoir préciser ce détail
lors de mon premier post.

Merci de ton aide

Marcus


Bonjour,
Attention, si tu utilises ainsi le .name des feuilles
aux noms qui pourraient varier "Sommaire" ou "sommaire"
"Feuil2" ou "feuille 2"
Sub test()
Dim i&
Application.ScreenUpdating = False
With Worksheets("sommaire")
.Range("R2", .Range("A65536").End(xlUp).Address) _
.ClearContents
End With
For i = 1 To 3
With Worksheets("feuille " & i)
.[a34:r47].Copy
Worksheets("sommaire").[a65536].End(xlUp) _
(2).PasteSpecial Paste:=xlPasteValues
End With
Next i
Worksheets("sommaire").Activate
End Sub
'lSteph
Bonjour à vous tous
Voici mon problème. J'ai quatre feuilles.
Feuille 1, Feuille 2, Feuille 3 et Sommaire.
Chacune des feuilles contient le même texte placé au même endroit, tout ce
qui change, c'est un tableau avec le nom des employés qui commence avec les
en-têtes à la cellule A34 jusqu'à la colonne R47. Ce que je veux faire, c'est
de prendre le tableau des noms de chaque feuille et d'avoir tout les données
dans la feuille sommaire. J,ai une macro, mais elle commence à la ligne A34
mais jusqu'à la fin de la feuille (A65536), moi je veux qu'elle arrête à la
ligne 47.
Voici mon code
Sub un_test()
Worksheets("sommaire").Range("a1").CurrentRegion.ClearContents
Dim c As Range, PlageRecap As Range, Plage As Range
Dim Ligne As Long
Sheets("sommaire").Select
Set PlageRecap = Range("A1", Range("A65536").End(xlUp))
Ligne = PlageRecap.Rows.Count
Sheets("feuille 1").Select
Set Plage = Range("A34", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 2").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
Sheets("feuille 3").Select
Set Plage = Range("A38", Range("A65536").End(xlUp))
For Each c In Plage
If Not IsNumeric(Application.Match(c, PlageRecap, 0)) Then
c.EntireRow.Copy Sheets("sommaire").Cells(Ligne, 1)
Ligne = Ligne + 1
End If
Next c
End Sub
En espérant que le tout est assez claire
Merci de votre aide
Marc















Publicité
Poster une réponse
Anonyme