recuperer des données de plusieurs feuilles

Le
lolo
Bonjour

Je souhaiterais regrouper des données de plusieurs feuilles excel dans
une feuille nommée synthese pour réaliser des indicateurs
En fait j'ai 8 feuilles où j'ai besoin de recuperer des données de la
colonne A à la colonne O et 2 autres feuilles qui ne me servent pas.

J'ai regarder un peu sur le net j'ai trouvé quelque chose mais mes
valeurs se mettent en ligne non en colonne
Pouvez vous m'aider ?

Je vous remercie
Lolo
Si dessous le code

Sub Assembler()
Dim i As Long, j As Long
Worksheets("SYNTHESE").Select
For i = 1 To Worksheets.Count - 2
j = Range("A65536").End(xlUp).Row + 1
With Worksheets(i)
Cells(j, 1).Value = .Range("A1").Value
Cells(j, 2).Value = .Range("A2").Value
Cells(j, 3).Value = .Range("A3").Value
Cells(j, 4).Value = .Range("A3").Value
Cells(j, 5).Value = .Range("A3").Value
Cells(j, 6).Value = .Range("A3").Value
Cells(j, 7).Value = .Range("A3").Value
End With
Next
End Sub
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
MichD
Le #23851401
Bonjour,

Cette procédure ajoute une feuille nommée "Recap" et copie dans celle-ci toutes les
données de toutes les autres feuilles du classeur. La première ligne d'étiquettes n'est
recopiée qu'une seule fois au départ.

À mettre dans un module standard :
'----------------------------------
Sub Test()
Dim Sh As Worksheet, DerLig As Long
Dim LastRow As Long, A As Integer
Dim F As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Recap").Delete
Application.DisplayAlerts = True
Set F = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))
F.Name = "Recap"
For Each Sh In ThisWorkbook.Worksheets
If UCase(Sh.Name) <> "RECAP" Then
A = A + 1
With Sh
DerLig = .Range("A:O").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With F
If IsEmpty(.UsedRange) Then
LastRow = 1
Else
LastRow = .Range("A:O").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
End If
'If LastRow > 1 Then LastRow = LastRow + 1
End With
If A = 1 Then
.Range("A1:O" & DerLig).Copy _
F.Range("A" & LastRow)
Else
.Range("A2:O" & DerLig).Copy _
F.Range("A" & LastRow)
End If
End With
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
'----------------------------------



MichD
------------------------------------------
"lolo" a écrit dans le message de groupe de discussion :


Bonjour

Je souhaiterais regrouper des données de plusieurs feuilles excel dans
une feuille nommée synthese pour réaliser des indicateurs
En fait j'ai 8 feuilles où j'ai besoin de recuperer des données de la
colonne A à la colonne O et 2 autres feuilles qui ne me servent pas.

J'ai regarder un peu sur le net j'ai trouvé quelque chose mais mes
valeurs se mettent en ligne non en colonne
Pouvez vous m'aider ?

Je vous remercie
Lolo
Si dessous le code

Sub Assembler()
Dim i As Long, j As Long
Worksheets("SYNTHESE").Select
For i = 1 To Worksheets.Count - 2
j = Range("A65536").End(xlUp).Row + 1
With Worksheets(i)
Cells(j, 1).Value = .Range("A1").Value
Cells(j, 2).Value = .Range("A2").Value
Cells(j, 3).Value = .Range("A3").Value
Cells(j, 4).Value = .Range("A3").Value
Cells(j, 5).Value = .Range("A3").Value
Cells(j, 6).Value = .Range("A3").Value
Cells(j, 7).Value = .Range("A3").Value
End With
Next
End Sub
lolo
Le #23851661
Bonjour

Merci Mich D

Ce que je n'ai pas dit c'est que sous mes données j'ai également des
case qui sont en fait des case de calculs pour connaitre le mois
suivant la date.
Quand je fais la macro ça fonctionne nickel par contre ça me met tous
les 0 et 1 et ça me decale mes résulats
Je joint mon fichier pour plus de comprehension

http://www.cijoint.fr/cjlink.php?file=cj201110/cijkim0Ufv.xls

Merci de votre aide
@++
Lolo
MichD
Le #23851651
Essaie comme ceci :


Sub Test()
Dim Sh As Worksheet, DerLig As Long
Dim LastRow As Long, A As Integer
Dim F As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Recap").Delete
Application.DisplayAlerts = True
Set F = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))
F.Name = "Recap"
For Each Sh In ThisWorkbook.Worksheets
If UCase(Sh.Name) <> "RECAP" Then
A = A + 1
With Sh
DerLig = .Range("C:O").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With F
If IsEmpty(.UsedRange) Then
LastRow = 1
Else
LastRow = .Range("C:O").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
End If
End With
If A = 1 Then
.Range("A1:O" & DerLig).Copy _
F.Range("A" & LastRow)
Else
.Range("A2:O" & DerLig).Copy _
F.Range("A" & LastRow)
End If
End With
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub





MichD
------------------------------------------
"lolo" a écrit dans le message de groupe de discussion :


Bonjour

Merci Mich D

Ce que je n'ai pas dit c'est que sous mes données j'ai également des
case qui sont en fait des case de calculs pour connaitre le mois
suivant la date.
Quand je fais la macro ça fonctionne nickel par contre ça me met tous
les 0 et 1 et ça me decale mes résulats
Je joint mon fichier pour plus de comprehension

http://www.cijoint.fr/cjlink.php?file=cj201110/cijkim0Ufv.xls

Merci de votre aide
@++
Lolo
lolo
Le #23855571
Bonjour Mich D,

Je te remercie ça fonctionne nickel !! sauf que j'ai 4 autres feuilles
qui ne me servent pas... et les données sont exportées aussi.
Est il possible de ne pas prendre en compte ces 4 feuilles ?

Mes feuilles s'appellent CU - CL - PLAN D'ACTION - TABLEAU DE BORD.

Merci de ton aide quel temps gagné...

Bonne journée

@+
Lolo
MichD
Le #23856621
'--------------------------------------------
Sub Test()
Dim Sh As Worksheet, DerLig As Long
Dim LastRow As Long, A As Integer
Dim F As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Recap").Delete
Application.DisplayAlerts = True
Set F = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))
F.Name = "Recap"
For Each Sh In ThisWorkbook.Worksheets
Select Case UCase(Sh.Name)
Case Is = "CU", "CL", "PLAN D'ACTION", _
"TABLEAU DE BORD", "RECAP"
Case Else
A = A + 1
With Sh
DerLig = .Range("C:O").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With F
If IsEmpty(.UsedRange) Then
LastRow = 1
Else
LastRow = .Range("C:O").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
End If
End With
If A = 1 Then
.Range("A1:O" & DerLig).Copy _
F.Range("A" & LastRow)
Else
.Range("A2:O" & DerLig).Copy _
F.Range("A" & LastRow)
End If
End With
End Select
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'--------------------------------------------



MichD
------------------------------------------
lolo
Le #23857361
Un grand merci à toi MichD !

C'est exactement ce que je voulais ça fonctionne nickel !!

Bonne journée et bon courage !

Lolo
gresko Hors ligne
Le #24849542
Le mercredi 12 Octobre 2011 à 11:51 par MichD :
'--------------------------------------------
Sub Test()
Dim Sh As Worksheet, DerLig As Long
Dim LastRow As Long, A As Integer
Dim F As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Recap").Delete
Application.DisplayAlerts = True
Set F = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))
F.Name = "Recap"
For Each Sh In ThisWorkbook.Worksheets
Select Case UCase(Sh.Name)
Case Is = "CU", "CL", "PLAN D'ACTION", _
"TABLEAU DE BORD", "RECAP"
Case Else
A = A + 1
With Sh
DerLig = .Range("C:O").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
With F
If IsEmpty(.UsedRange) Then
LastRow = 1
Else
LastRow = .Range("C:O").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
End If
End With
If A = 1 Then
.Range("A1:O" & DerLig).Copy _
F.Range("A" & LastRow)
Else
.Range("A2:O" & DerLig).Copy _
F.Range("A" & LastRow)
End If
End With
End Select
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'--------------------------------------------



MichD
------------------------------------------


Bonjour à tous,

J'aurai aimé savoir quelle commande il faudrait insérer dans ce code pour, par exemple, ne pas faire apparaître la ligne 3 ou la colonne C ou encore la cellule H2.

Merci d'avance pour votre réponse.

Gresko
Publicité
Poster une réponse
Anonyme