Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel recuperer des données de plusieurs feuilles

recuperer des données de plusieurs feuilles

7 réponses
Avatar
lolo
Bonjour

Je souhaiterais regrouper des donn=E9es de plusieurs feuilles excel dans
une feuille nomm=E9e synthese pour r=E9aliser des indicateurs
En fait j'ai 8 feuilles o=F9 j'ai besoin de recuperer des donn=E9es de la
colonne A =E0 la colonne O et 2 autres feuilles qui ne me servent pas.

J'ai regarder un peu sur le net j'ai trouv=E9 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 =3D 1 To Worksheets.Count - 2
j =3D Range("A65536").End(xlUp).Row + 1
With Worksheets(i)
Cells(j, 1).Value =3D .Range("A1").Value
Cells(j, 2).Value =3D .Range("A2").Value
Cells(j, 3).Value =3D .Range("A3").Value
Cells(j, 4).Value =3D .Range("A3").Value
Cells(j, 5).Value =3D .Range("A3").Value
Cells(j, 6).Value =3D .Range("A3").Value
Cells(j, 7).Value =3D .Range("A3").Value
End With
Next
End Sub
Signaler un problème avec ce contenu

7 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
MichD
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
Avatar
lolo
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
Avatar
MichD
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
Avatar
lolo
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
Avatar
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
------------------------------------------
Avatar
lolo
Un grand merci à toi MichD !

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

Bonne journée et bon courage !

Lolo
Avatar
gresko
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