Récupérer contenu de cellules sur plusieurs onglets et copier

Le
Pierre F.
Bonjour à toutes et tous;

J'ai un dossier xls de 41 feuilles
Je souhaiterais récupérer par macro sur chacune des feuilles 3 à 41=
le
contenu de la cellule (X, 6), c'est à dire la ligne X (X étant le num=
éro
de la ligne de la cellule active) et la colonne F.

Puis, dans un autre fichier (ou une nouvelle feuille, c'est égal), je
souhaiterais copier ces 38 contenus dans la colonne B à raison de 1
contenu par ligne

J'ai commencé une macro mais elle bogue (L'indice n'appartient pas à=
la
sélection) sur la ligne * sem(i)= i *.

--
Sub CreerTablUn()

ligne = ActiveCell.Row 'ligne celleule active

For i = 1 To 38

Sheets(i+2).Activate 'va à la feuille i+2

sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6 'variable pour le contenu de cell(ligne,6)

Next i

'créer le titre du nouveau fichier

src = "Suivi"
dest = src & Format(Date, "_mm_yyyy") & ".xls"

'Copier en col A un numéro et en B le contenu de la cellule de l'onglet=

correspondant

For j = 3 To 41
Cells(j, 1) = j - 2
Cells(j, 2) = com(j - 2)
Next j

ActiveWorkbook.SaveAs Filename:=dest
ActiveWorkbook.Close

End Sub
--

Où est l'erreur ??

Merci de votre aide.

Cordialement,
Pierre F.
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
Daniel.C
Le #21035001
Bonjour.
Peut-être comme ça (non testé) bien que ne ne voie pas ou tu as l'usage
de "sem" :

Sub CreerTablUn()

Dim sem(), com(), ligne As Long
ligne = ActiveCell.Row 'ligne celleule active

For i = 1 To 38
ligne = ActiveCell.Row 'ligne celleule active
Sheets(i + 2).Activate 'va à la feuille i+2
ReDim Preserve sem(i)
ReDim Preserve com(i)
sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6) 'variable pour le contenu de
cell(ligne,6)

Next i

'créer le titre du nouveau fichier

src = "Suivi"
dest = src & Format(Date, "_mm_yyyy") & ".xls"

'Copier en col A un numéro et en B le contenu de la cellule de l'onglet
correspondant

For j = 3 To 41
Cells(j, 1) = j - 2
Cells(j, 2) = com(j - 2)
Next j

ActiveWorkbook.SaveAs Filename:Þst
ActiveWorkbook.Close

End Sub


Bonjour à toutes et tous;

J'ai un dossier xls de 41 feuilles
Je souhaiterais récupérer par macro sur chacune des feuilles 3 à 41 le
contenu de la cellule (X, 6), c'est à dire la ligne X (X étant le numéro de
la ligne de la cellule active) et la colonne F.

Puis, dans un autre fichier (ou une nouvelle feuille, c'est égal), je
souhaiterais copier ces 38 contenus dans la colonne B à raison de 1 contenu
par ligne

J'ai commencé une macro mais elle bogue... (L'indice n'appartient pas à la
sélection) sur la ligne * sem(i)= i *.

--------------------
Sub CreerTablUn()

ligne = ActiveCell.Row 'ligne celleule active

For i = 1 To 38

Sheets(i+2).Activate 'va à la feuille i+2

sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6 'variable pour le contenu de cell(ligne,6)

Next i

'créer le titre du nouveau fichier

src = "Suivi"
dest = src & Format(Date, "_mm_yyyy") & ".xls"

'Copier en col A un numéro et en B le contenu de la cellule de l'onglet
correspondant

For j = 3 To 41
Cells(j, 1) = j - 2
Cells(j, 2) = com(j - 2)
Next j

ActiveWorkbook.SaveAs Filename:Þst
ActiveWorkbook.Close

End Sub
--------------------

Où est l'erreur ??

Merci de votre aide.

Cordialement,
Pierre F.


Daniel.C
Le #21035191
Oups. J'ai pposté ton propre code :

Sub CreerTablUn()

Dim sem(), com(), ligne As Long
ligne = ActiveCell.Row 'ligne celleule active

For i = 1 To 38
ligne = ActiveCell.Row 'ligne celleule active
Sheets(i + 2).Activate 'va à la feuille i+2
ReDim Preserve sem(i)
ReDim Preserve com(i)
sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6) 'variable pour le contenu de
cell(ligne,6)

Next i

'créer le titre du nouveau fichier

src = "Suivi"
dest = src & Format(Date, "_mm_yyyy") & ".xls"

'Copier en col A un numéro et en B le contenu de la cellule de l'onglet
correspondant

For j = 3 To 41
Cells(j, 1) = j - 2
Cells(j, 2) = com(j - 2)
Next j

ActiveWorkbook.SaveAs Filename:Þst
ActiveWorkbook.Close

End Sub

Daniel

Bonjour.
Peut-être comme ça (non testé) bien que ne ne voie pas ou tu as l'usage de
"sem" :

Sub CreerTablUn()

Dim sem(), com(), ligne As Long
ligne = ActiveCell.Row 'ligne celleule active

For i = 1 To 38
ligne = ActiveCell.Row 'ligne celleule active
Sheets(i + 2).Activate 'va à la feuille i+2
ReDim Preserve sem(i)
ReDim Preserve com(i)
sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6) 'variable pour le contenu de cell(ligne,6)

Next i

'créer le titre du nouveau fichier

src = "Suivi"
dest = src & Format(Date, "_mm_yyyy") & ".xls"

'Copier en col A un numéro et en B le contenu de la cellule de l'onglet
correspondant

For j = 3 To 41
Cells(j, 1) = j - 2
Cells(j, 2) = com(j - 2)
Next j

ActiveWorkbook.SaveAs Filename:Þst
ActiveWorkbook.Close

End Sub


Bonjour à toutes et tous;

J'ai un dossier xls de 41 feuilles
Je souhaiterais récupérer par macro sur chacune des feuilles 3 à 41 le
contenu de la cellule (X, 6), c'est à dire la ligne X (X étant le numéro de
la ligne de la cellule active) et la colonne F.

Puis, dans un autre fichier (ou une nouvelle feuille, c'est égal), je
souhaiterais copier ces 38 contenus dans la colonne B à raison de 1 contenu
par ligne

J'ai commencé une macro mais elle bogue... (L'indice n'appartient pas à la
sélection) sur la ligne * sem(i)= i *.

--------------------
Sub CreerTablUn()

ligne = ActiveCell.Row 'ligne celleule active

For i = 1 To 38

Sheets(i+2).Activate 'va à la feuille i+2

sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6 'variable pour le contenu de cell(ligne,6)

Next i

'créer le titre du nouveau fichier

src = "Suivi"
dest = src & Format(Date, "_mm_yyyy") & ".xls"

'Copier en col A un numéro et en B le contenu de la cellule de l'onglet
correspondant

For j = 3 To 41
Cells(j, 1) = j - 2
Cells(j, 2) = com(j - 2)
Next j

ActiveWorkbook.SaveAs Filename:Þst
ActiveWorkbook.Close

End Sub
--------------------

Où est l'erreur ??

Merci de votre aide.

Cordialement,
Pierre F.




michdenis
Le #21035181
Bonjour,

Essaie ceci :

Avant de lancer la macro, assure toi que tu es sur la bonne
feuille et que c'est la bonne cellule qui est sélectionnée.

'----------------------------------------
Sub test()
Dim xlWh As XlSheetType
xlWh = xlWorksheet
Dim F As Worksheet, Wk As Workbook, X As Long

X = ActiveCell.Row

Application.ScreenUpdating = False
Application.EnableEvents = False
'Ajouter un classeur avec seulement une feuille
Set Wk = Workbooks.Add(xlWh)
Set F = Wk.ActiveSheet
F.Name = "Sommaire"

With ThisWorkbook
For A = 3 To 3
b = b + 1
F.Range("B" & b) = .Worksheets(A).Range("F" & X)
Next
.Activate
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'----------------------------------------



"Pierre F." 18e2b$4b5b298c$55da27a5$
Bonjour à toutes et tous;

J'ai un dossier xls de 41 feuilles
Je souhaiterais récupérer par macro sur chacune des feuilles 3 à 41 le
contenu de la cellule (X, 6), c'est à dire la ligne X (X étant le numéro
de la ligne de la cellule active) et la colonne F.

Puis, dans un autre fichier (ou une nouvelle feuille, c'est égal), je
souhaiterais copier ces 38 contenus dans la colonne B à raison de 1
contenu par ligne

J'ai commencé une macro mais elle bogue... (L'indice n'appartient pas à la
sélection) sur la ligne * sem(i)= i *.

--------------------
Sub CreerTablUn()

ligne = ActiveCell.Row 'ligne celleule active

For i = 1 To 38

Sheets(i+2).Activate 'va à la feuille i+2

sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6 'variable pour le contenu de cell(ligne,6)

Next i

'créer le titre du nouveau fichier

src = "Suivi"
dest = src & Format(Date, "_mm_yyyy") & ".xls"

'Copier en col A un numéro et en B le contenu de la cellule de l'onglet
correspondant

For j = 3 To 41
Cells(j, 1) = j - 2
Cells(j, 2) = com(j - 2)
Next j

ActiveWorkbook.SaveAs Filename:Þst
ActiveWorkbook.Close

End Sub
--------------------

Où est l'erreur ??

Merci de votre aide.

Cordialement,
Pierre F.
michdenis
Le #21035431
Une suggestion,

Tu devrais protéger ton classeur (pas les feuilles) afin d'empêcher
de modifier l'ordre des feuilles, la macro ne serait probablement
plus d'un bon usage.



"michdenis"
Bonjour,

Essaie ceci :

Avant de lancer la macro, assure toi que tu es sur la bonne
feuille et que c'est la bonne cellule qui est sélectionnée.

'----------------------------------------
Sub test()
Dim xlWh As XlSheetType
xlWh = xlWorksheet
Dim F As Worksheet, Wk As Workbook, X As Long

X = ActiveCell.Row

Application.ScreenUpdating = False
Application.EnableEvents = False
'Ajouter un classeur avec seulement une feuille
Set Wk = Workbooks.Add(xlWh)
Set F = Wk.ActiveSheet
F.Name = "Sommaire"

With ThisWorkbook
For A = 3 To 3
b = b + 1
F.Range("B" & b) = .Worksheets(A).Range("F" & X)
Next
.Activate
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'----------------------------------------



"Pierre F." 18e2b$4b5b298c$55da27a5$
Bonjour à toutes et tous;

J'ai un dossier xls de 41 feuilles
Je souhaiterais récupérer par macro sur chacune des feuilles 3 à 41 le
contenu de la cellule (X, 6), c'est à dire la ligne X (X étant le numéro
de la ligne de la cellule active) et la colonne F.

Puis, dans un autre fichier (ou une nouvelle feuille, c'est égal), je
souhaiterais copier ces 38 contenus dans la colonne B à raison de 1
contenu par ligne

J'ai commencé une macro mais elle bogue... (L'indice n'appartient pas à la
sélection) sur la ligne * sem(i)= i *.

--------------------
Sub CreerTablUn()

ligne = ActiveCell.Row 'ligne celleule active

For i = 1 To 38

Sheets(i+2).Activate 'va à la feuille i+2

sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6 'variable pour le contenu de cell(ligne,6)

Next i

'créer le titre du nouveau fichier

src = "Suivi"
dest = src & Format(Date, "_mm_yyyy") & ".xls"

'Copier en col A un numéro et en B le contenu de la cellule de l'onglet
correspondant

For j = 3 To 41
Cells(j, 1) = j - 2
Cells(j, 2) = com(j - 2)
Next j

ActiveWorkbook.SaveAs Filename:Þst
ActiveWorkbook.Close

End Sub
--------------------

Où est l'erreur ??

Merci de votre aide.

Cordialement,
Pierre F.
Pierre F.
Le #21036811
Daniel.C a écrit :
Oups. J'ai posté ton propre code :

Sub CreerTablUn()
Dim sem(), com(), ligne As Long
ligne = ActiveCell.Row 'ligne celleule active
For i = 1 To 38
ligne = ActiveCell.Row 'ligne celleule active
Sheets(i + 2).Activate 'va à la feuille i+2
ReDim Preserve sem(i)
ReDim Preserve com(i)
sem(i) = i 'variable pour le numéro de l'onglet
com(i) = Cells(ligne, 6) 'variable pour le contenu de cell(lign e,6)
Next i
...
End Sub




Mille mercis; ça marche!; c'est les Dim et Redim qui me manquaient

Cordialement,
Pierre F.
Pierre F.
Le #21036851
michdenis a écrit :

Tu devrais protéger ton classeur (pas les feuilles) afin d'empêcher
de modifier l'ordre des feuilles, la macro ne serait probablement
plus d'un bon usage.



"michdenis"
Bonjour,

Essaie ceci :

Avant de lancer la macro, assure toi que tu es sur la bonne
feuille et que c'est la bonne cellule qui est sélectionnée.



Merci pour les conseils et la macro; c'est super rapide!

En jouant sur les deux réponses (la tienne et celle de Daniel), je peux
bien avancer dans mon projet.

Bon dimanche

Cordialement,
Pierre F.
Publicité
Poster une réponse
Anonyme