Débuggage... Ma macro ne fonctionne qu'à moitié

Résolu/Fermé

DJ333 Messages postés 5 Date d'inscription lundi 25 mars 2019 Statut Membre Dernière intervention 27 mars 2019 - 26 mars 2019 à 09:51
DJ333 Messages postés 5 Date d'inscription lundi 25 mars 2019 Statut Membre Dernière intervention 27 mars 2019 - 27 mars 2019 à 16:39

Bonjour,

Grâce aux conseils reçus sur ce forum j'ai réussi à faire fonctionner ma macro, cependant elle ne se lance pas entièrement et je ne comprends pas pourquoi... Seules 2 feuilles sont créées alors que 11 devraient l'être. Mon objectif est de créer des feuilles selon une feuille de référence à condition que des cellules soient renseignés.
Voici le code :
Sub crefeuille1()
If Range("C2") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e2")
End With
End If
End Sub
Sub crefeuille2()
If Range("C3") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e3")
End With
End If
End Sub
Sub crefeuille3()
If Range("C4") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e4")
End With
End If
End Sub
Sub crefeuille4()
If Range("C5") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e5")
End With
End If
End Sub
Sub crefeuille5()
If Range("C6") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e6")
End With
End If
End Sub
Sub crefeuille6()
If Range("C7") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e7")
End With
End If
End Sub
Sub crefeuille7()
If Range("C8") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e8")
End With
End If
End Sub
Sub crefeuille8()
If Range("C9") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e9")
End With
End If
End Sub
Sub crefeuille9()
If Range("C10") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e10")
End With
End If
End Sub
Sub crefeuille10()
If Range("C11") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e11")
End With
End If
End Sub
Sub crefeuille11()
If Range("C12") <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
With MySheet
.Name = Worksheets("Revue Patri").Range("e12")
End With
End If
End Sub
Sub Button1_Click()
Call crefeuille1 'Macro1
Call crefeuille2 'Macro2
Call crefeuille3 'Macro3
Call crefeuille4 'Macro4
Call crefeuille5 'Macro5
Call crefeuille6 'Macro6
Call crefeuille7 'Macro7
Call crefeuille8 'Macro8
Call crefeuille9 'Macro9
Call crefeuille10 'Macro10
Call crefeuille11 'Macro11
End Sub

A voir également:

Débuggage... Ma macro ne fonctionne qu'à moitié
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Macro recorder - Télécharger - Confidentialité
Moitié a4 - Guide

1 réponse

Réponse 1 / 1

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
27 mars 2019 à 14:32

Bonjour,

Il suffit de faire une seule boucle pour créer tes 12 feuilles, comme ceci:

Option Explicit
Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim MySheet As Worksheet
Dim NoLig As Long
    Set FL1 = Worksheets("Revue Patri")
    NoCol = 3 'lecture de la colonne c
    For NoLig = 2 To Split(FL1.UsedRange.Address, "$")(4)
        If FL1.Range("C" & NoLig) <> "" Then
Sheets("Revue type").Select
Sheets("Revue type").Copy After:=Sheets(2)
Set MySheet = ActiveSheet
MySheet.Name = FL1.Range("E" & NoLig)
End If
    Next
    Set FL1 = Nothing
End Sub

DJ333 Messages postés 5 Date d'inscription lundi 25 mars 2019 Statut Membre Dernière intervention 27 mars 2019
27 mars 2019 à 16:39

Un grand merci
en effet tout fonctionne!

Discussions similaires

La moitié de l'écran de ma smart tv est sombre sur une moiti

Ecran partiellement sombre TV Samsung

TV écran à moitié noir

TV LG Led : Moitié gauche écran plus sombre

Pourquoi mon Outlook est à moitié en anglais moitié en français ?

Discussions similaires

Newsletters