XL 2016 Modif macro si cellule vide

[christ77000]

Bonsoir à tous, il y a quelque que jours on m'a aidé pour cette macro. Et avec les testes sur mon fichier je me rend compte que si la cellule C30 est égale à vide le code plante. Je n'avais encore testé a vide. J'ai essayer en mettant 0, il me créer la feuille la je pense que c'est normal puisqu'il y a valeur. Mais comment faire pour la cellule vide. Mais elle n'est pas vraiment vide car j'ai lu que le faite de mettre en "C30 la formule =SI(C29="";"";CONCATENER(C29;"-";$A$2)) le résultat est vide visuellement. Sauf si je dis un ânerie ou mal compris. Merci pour votre aide.

Sub Creation_IT6_par_nom()
    Dim DerLig As Long, i As Integer
    DerLig = Feuil2.Range("D" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = DerLig To 29 Step -1
        If TypeName(Evaluate("='[" & ThisWorkbook.Name & "]" & Feuil2.Cells(i, 4) & "'!A:A")) <> "Range" Then
            Sheets("IT6").Copy after:=Feuil2
            ActiveSheet.Name = Feuil2.Cells(i, 4)
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[christ77000]

Bonsoir Laurant95 et merci pour ton aide.

Je viens de tester ton code, il me fait quand même une copie de la feuille IT6 mais renommer IT6(2) Et si en "C30"je lui dit =0 au lieu de "" comment il faudrait modifier ton code.

 

[christ77000]

RE, viens de retirer la formule qui était en C30 =SI(C29="";"";CONCATENER(C29;"-";$A$2) il se passe la même chose.

 

[christ77000]

En B5 l'utilisateur renseigne son nom et l'initial de son prénom dans la même cellule.
En B29 je reprends la valeur par =SI(B5=0;"";B5)
En C29 je récupère les initiales par =SI(B29="";"";MAJUSCULE(GAUCHE(B29;1)&STXT(B29;CHERCHE(" ";B29)+1;1)))
En D29 je rassemble les initiales + l'année par =SI(C29="";"";CONCATENER(C29;"-";$A$2))
Et la macro me crée une nouvelle copie de la feuille IT6 avec la valeur de D29.

Mais si la valeur de C29 est vide la macro ne doit pas crée de nouvelle feuille

J'espère avoir été plus claire.

 

[christ77000]

J'ai oublier de préciser que je fais la même chose de B29 à B33, il y donc cinq copies à faire au totl sauf si rien en D29, D30...jusqu'a D33

 

[christ77000]

Bonjour à tous, j'ai essayer de modifier le code en ajoutant la ligne If Application.CountA(Range("D29:33")) = 0 Then Exit Sub mais ca ne change rien.

Sub Creation_IT6_par_nom()
    Dim DerLig As Long, i As Integer
    DerLig = Feuil2.Range("D" & Rows.Count).End(xlUp).Row
    If Application.CountA(Range("D29:D33")) = 0 Then Exit Sub
    Application.ScreenUpdating = False
  On Error Resume Next
    For i = DerLig To 29 Step -1
        If TypeName(Evaluate("='[" & ThisWorkbook.Name & "]" & Feuil2.Cells(i, 4) & "'!A:A")) <> "Range" Then
            Sheets("IT6").Copy after:=Feuil2
            ActiveSheet.Name = Feuil2.Cells(i, 4)
        End If
    Next i
  On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

 

[christ77000]

Bonsoir Laurent950 et merci pour ton aide.
Je viens de lancer ton code il ne se passe plus rien, quand je retire la ligne il me fait bien les lignes remplies en nouvelles page et la vide en IT6(2)

 

[christ77000]

si cela ne te dérange pas je te donne le fichier. Ce sera certainement plus simple.

 

[christ77000]

Bonjour à tous, j'ai re tente de modifier le code mais rien y fait la dans ce cas il ne copie prend en compte que la dernière et le code plante sur ActiveSheet.Name = Feuil2.Cells(i, 4) c'est vraiment une galère...

Sub Creation_IT6_par_nom()
    Dim DerLig As Long, i As Integer
    DerLig = Feuil2.Range("D" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = DerLig To 29 Step -1
    If Not IsEmpty(Range("D" & i).Value) Then
        If TypeName(Evaluate("='[" & ThisWorkbook.Name & "]" & Feuil2.Cells(i, 4) & "'!A:A")) <> "Range" Then
            Sheets("IT6").Copy after:=Feuil2
            ActiveSheet.Name = Feuil2.Cells(i, 4)
        End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[christ77000]

Si j'ai bien tout compris

Sub Macro2()
'
' Macro2 Macro
'

   Sheets("Feuil1").Select
    Range("D29").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",R[5]C[-1]*R[-24]C[-2])"
    Range("D29").Select
    Selection.Copy
    Sheets("toto").Select
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("B5").Select
    
End Sub

 

[laurent950]

Bonsoir,
Je sais pas résoudre votre probléme
Cordialement
laurent

 

[christ77000]

Merci à vous pour l'aide, j'espère jute trouver une solution à mon prolème