Arréter un code quand il arrive à l'onglet tout à droite

[jeanmomo]

Bonsoir à tous,

Je suis en train de faire une petite macro qui est incorporée a sein d'un fichier excel nommé Forum.xls

Ce fichier Forum.xls est placé dans un dossier où se trouve x autres fichiers données.xls ayant la même structure (sauf le nombre d'onglets diffèrent).

Ce que je souhaite c'est faire un résumé des informations contenues dans chaque onglet de chaque fichier données.xls (une ligne de résumé par onglet).

Pour se faire, j'ai déjà récupéré tout un tas de bout de codes qui me permettent de :

- aller ouvrir un premier fichier données.xls du même dossier;
- me mettre sur l'onglet de gauche;
- copier certaines infos et les coller sur la même ligne de mon fichier forum.xls;
- aller à la ligne sur ce fichier forum, puis aller sur le deuxième onglet de ce fichier "donnée"


Par contre, j'ai un message d'erreur au moment où il veut encore se mettre sur l'onglet situé à droite alors que je suis déjà sur ce dernier onglet.

Il me faudrait donc mettre dans un code un bout de code en plus, qui dirait que si je suis sur le dernier onglet du fichier donnée.xls, alors il faut fermer ce fichier, et ouvrir un suivant.


PS: le code est en cours, et normalement je devrai réussir à le terminer (il manque des bouts dedans que je mettrai par la suite). si je trouve une réponse à mon problème ci-dessus.
J'ai déjà effectué un travail comparable, mais là je n'allais cherché les données que sur un unique onglet de chacun de ces fichiers données.xls



Pour info, voici le code en cours :



Sub forum()

Application.ScreenUpdating = False
Application.DisplayAlerts = False



Dim Temp As String
Dim Ligne As Long


Temp = Dir(ActiveWorkbook.Path & "\*.xls")


Do While Temp <> ""
If Temp <> "Forum.xls" Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp

'aller sur l'onglet tout à gauche
Sheets(1).Select

Dim i As Integer
Dim NomOnglet As Variant


For i = 1 To Worksheets.Count

'copie 1
Range("D2").Select
Selection.Copy
Windows("Forum.xls").Activate



Range("A1000").End(xlUp).Select

ActiveCell.Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select

ActiveWindow.ActivateNext


'copie 2
Range("A9").Copy
Windows("Forum.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveWindow.ActivateNext

'copie 3
Range("B9").Copy
Windows("Forum.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveWindow.ActivateNext

'copie 4
Range("A10").Copy
Windows("Forum.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveWindow.ActivateNext

'copie 5
Range("B10").Copy
Windows("Forum.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveWindow.ActivateNext

'copie 6
Range("A19").Copy
Windows("Forum.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveWindow.ActivateNext

'copie 7
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy

Windows("Forum.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveWindow.ActivateNext

'copie 8
Range("D6").Copy
Windows("Forum.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
ActiveWindow.ActivateNext

'copie 9
Range("D15").Copy
Windows("Forum.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select



'on se remet en colonne A à la ligne en dessous
Range("A1000").End(xlUp).Select

ActiveCell.Offset(1, 0).Select


ActiveWindow.ActivateNext

ActiveSheet.Next.Select


Next i

End If
Temp = Dir
Loop
End Sub




Merci par avance à tout ceux et celles qui me viendront en aide.
Cordialement

 

[Paf]

Re : Arréter un code quand il arrive à l'onglet tout à droite

Bonjour

en fin de boucle For i = 1 To Worksheets.Count on trouve l'instruction ActiveSheet.Next.Select
qui sélectionne la feuille suivante.
Quand i=Worksheets.Count (dernière feuille ) ActiveSheet.Next.Select essaie de sélectionner la feuille suivante ...., mais il n'y en a plus ...
Supprimer l'instruction ActiveSheet.Next.Select.

Sans pouvoir faire de tests, pas sûr que les copies fonctionnent encore, mais de toutes façon il y aurait du ménage et de l'optimisation à prévoir.

A+

 

[Robert]

Re : Arréter un code quand il arrive à l'onglet tout à droite

Bonsoir Jeanmomo, bonsoir le forum,

Sans tester (tu n'as pas founi le fichier pour le faire...), je te propose le code ci-dessous mais je suis pas sûr d'avoir bien compris... Surtout ton code pour la copie Nº 7. J'ai mis A1 pour la variable PL(7). Tu corrigeras.
Le code commenté :

Sub forum()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim Dest As Range 'déclare la variable Dest (cellule de Destination)
Dim PL(1 To 9) As Range 'déclare le tableau de 9 variables PL (PLages)
Dim I As Byte 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (Incrément)

Application.ScreenUpdating = False 'masque les rafraîchiseements d'écran
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Sheets(1) 'définit l'onglet de destination OD
Temp = Dir(CD.Path & "\*.xls")
Do While Temp <> ""
    If Temp <> "Forum.xls" Then 'condition 1
        Workbooks.Open ActiveWorkbook.Path & "\" & Temp
        Set CS = ActiveWorkbook 'définit la classeur source CS
        If OD.Range("A1").Value = "" Then 'condition 2: si A1 est vide
            OD.Range("A1").Value = CS.Name 'place le nom du classeur source en A1
        Else 'sinon (condition 2)
            'place le nom du classeur source deux lignes après la dernière ligne éditée de la colonne 1(=A)
            OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Value = CS.Name
        End If 'fin de la condition 2
        Erase PL 'efface le tableau PL
        On Error GoTo suite 'gestion des erreurs (en cas d'erreur va à l'étiquette "suite")
        I = 1 'initialise la variable I
        'les lignes ci-dessou vont générer une erreur si l'onglet n'esxiste pas
        Set PL(I) = CS.Sheets(1).Range("D2"): I = I + 1 'définit la plage PL(I): incrémente I
        Set PL(I) = CS.Sheets(2).Range("A9"): I = I + 1 'définit la plage PL(I): incrémente I
        Set PL(I) = CS.Sheets(3).Range("B9"): I = I + 1 'définit la plage PL(I): incrémente I
        Set PL(I) = CS.Sheets(4).Range("A10"): I = I + 1 'définit la plage PL(I): incrémente I
        Set PL(I) = CS.Sheets(5).Range("B10"): I = I + 1 'définit la plage PL(I): incrémente I
        Set PL(I) = CS.Sheets(6).Range("A19"): I = I + 1 'définit la plage PL(I): incrémente I
        Set PL(I) = CS.Sheets(7).Range("A1"): I = I + 1 'la j'ai mis n'importe quoi car j'ai pas compris
        Set PL(I) = CS.Sheets(8).Range("D6"): I = I + 1 'définit la plage PL(I): incrémente I
        Set PL(I) = CS.Sheets(9).Range("D15"): I = I + 1 'définit la plage PL(I): incrémente I
suite: 'étiquette (si une erreur a été générée I-1 est la dernière plage valide donc le dernier onglet du classeur est : I-1
        If Err <> 0 Then Err.Clear 'si une erreur a été générée, effase l'erreur
        On Error GoTo 0 'annule gestion des erreurs
        For J = 1 To I - 1 'boucle sur les plages du tableau PL
            'définit la cellule de destination
            Set Dest = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
            Dest.Value = PL(J).Value 'récupère dans dest la valeur de la plage PL(J)
        Next J 'prochaine plage de la boucle
        CS.Close SaveChanges:=False 'ferme le classeur sans enregistrer
    End If 'fin de la condition 1
    Temp = Dir
Loop
Application.ScreenUpdating = True 'affiche les rafraîchiseements d'écran
End Sub

[Édition]
Bonsoir Paf on s'est croisé...