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

Résolu

DJ333 Messages postés 5 Date d'inscription Statut Membre Dernière intervention -
DJ333 Messages postés 5 Date d'inscription Statut Membre Dernière intervention - 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

Afficher la suite

A voir également:

Débuggage... Ma macro ne fonctionne qu'à moitié
Moitié a4 - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Jitbit macro recorder - Télécharger - Confidentialité
Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Tv lg écran à moitié sombre - Forum TV & Vidéo

1 réponse

Réponse 1 / 1

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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 Statut Membre Dernière intervention

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

Transformer un chiffre en lettres dans excel sans macro

Votre réponse

Discussions similaires