fusion de plusieurs feuilles en VBA

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

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

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

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 <mar...@discussions.microsoft.com> wrote:

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

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 <mar...@discussions.microsoft.com> wrote:

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

... commencer .. ligne 34 pour...France,..ligne >37.. USA et Suisse.

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 <mar...@discussions.microsoft.com> wrote:

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

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 <mar...@discussions.microsoft.com> wrote:

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