XL 2016 Modif macro si cellule vide

christ77000

XLDnaute Occasionnel
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.

VB:
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

XLDnaute Occasionnel
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

XLDnaute Occasionnel
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.

VB:
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
 
Dernière édition:

christ77000

XLDnaute Occasionnel
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...

Code:
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

XLDnaute Occasionnel
Si j'ai bien tout compris

VB:
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
 

Discussions similaires

Réponses
7
Affichages
292

Statistiques des forums

Discussions
311 720
Messages
2 081 896
Membres
101 833
dernier inscrit
sandra25