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

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.

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.

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." <pfornerodNO@SPAMhotmail.ch> a écrit dans le message de groupe de discussion :
18e2b$4b5b298c$55da27a5$28491@news.hispeed.ch...
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.

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" <michdenis@hotmail.com> a écrit dans le message de groupe de discussion :
unowFTFnKHA.3636@TK2MSFTNGP06.phx.gbl...
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." <pfornerodNO@SPAMhotmail.ch> a écrit dans le message de groupe de discussion :
18e2b$4b5b298c$55da27a5$28491@news.hispeed.ch...
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 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.

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" <michdenis@hotmail.com> a écrit dans le message de groupe de discussion :
unowFTFnKHA.3636@TK2MSFTNGP06.phx.gbl...
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.