Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2013 [RESOLU] Excel VBA - Incompatibilité de Type

BENAM69

XLDnaute Occasionnel
Bonjour,

J'ai un fichier qui réalise des copiés collés d'un onglet à l'autre.

Quand je lance mon code : Une boite de message apparaît avec : Incompatibilté de Type.

Mon code fonctionne sans problème, mais cette boîte de message d'erreur apparaît à chaque fois.
Savez-vous comment faire pour supprimer cette boîte de message ?
Cela est apparu au moment où j'ai ajouté mon code de suppression des lignes vides (Cf : Sub essai_supression())

J'ai beau cherché dans les forums, mais je ne trouve pas la réponse adaptée à mon problème.

Merci pour votre aide

# Sub Mat_IN()
DL2 = Sheets("Entrée Matière").Range("a50000").End(xlUp).Row + 1

' TABLEAU 1
With Worksheets("Stock Indutherms")
For x = 4 To .Range("a4").End(xlDown).Row
If .Cells(x, 9) <> "" Then
w = 1
For Z = 1 To 10
If Z = 5 Then Z = 9
Sheets("Entrée Matière").Cells(DL2, w) = .Cells(x, Z)
w = w + 1
Next Z
End If
DL2 = DL2 + 1
Next x
End With
End Sub
Sub Mat_OUT()
DL3 = Sheets("Sortie de Matière").Range("a50000").End(xlUp).Row + 1

' TABLEAU 1
With Worksheets("Stock Indutherms")
For x = 4 To .Range("a4").End(xlDown).Row
If .Cells(x, 11) <> "" Then
w = 1
For Z = 1 To 12
If Z = 5 Then Z = 11
Sheets("Sortie de Matière").Cells(DL3, w) = .Cells(x, Z)
w = w + 1
Next Z
End If
DL3 = DL3 + 1
Next x
End With
End Sub

Sub stock1()
With Worksheets("Stock Indutherms")
For x = 4 To .Range("a4").End(xlDown).Row
'If .Cells(x, 9) <> "" Then
'.Cells(x, 7) = .Cells(x, 7) + .Cells(x, 10) - .Cells(x, 12)
'.Cells(x, 13) = .Cells(x, 13) + .Cells(x, 12)

If .Cells(x, 9) <> "" Then
.Cells(x, 7) = .Cells(x, 7) + .Cells(x, 10) - .Cells(x, 12)
End If
If .Cells(x, 11) <> "" Then
.Cells(x, 7) = .Cells(x, 7) + .Cells(x, 10) - .Cells(x, 12)
.Cells(x, 13) = .Cells(x, 13) + .Cells(x, 12)
End If
'Prix EUR par Unité
If .Cells(x, 10) And .Cells(x, 14) <> "" Then
PrixConvert = .Cells(x, 14) * (-.Range("N1").Activate)
.Cells(x, 16) = .Cells(x, 16) + (PrixConvert * .Cells(x, 10))
End If
'Prix CHF par Unité
If .Cells(x, 10) And .Cells(x, 15) <> "" Then
.Cells(x, 16) = .Cells(x, 16) + (.Cells(x, 15) * .Cells(x, 10))
End If
'
Next x
End With

End Sub

Sub maj_fin()
With Worksheets("Stock Indutherms")
For n = 4 To .Range("a4").End(xlDown).Row
If .Cells(n, 9) <> "" Then
.Range(.Cells(n, 9), .Cells(n, 10)).ClearContents
.Range(.Cells(n, 14), .Cells(n, 15)).ClearContents
End If
Next n
For p = 4 To .Range("a4").End(xlDown).Row
If .Cells(p, 11) <> "" Then
.Range(.Cells(p, 11), .Cells(p, 12)).ClearContents
End If
Next p
End With
End Sub

Sub bordure2()

With Worksheets("Stock Indutherms")
For l = 4 To .Range("a4").End(xlDown).Row
If .Cells(l, 7) > .Cells(l, 8) Then
'TABLEAU 1 EFFACER LES BORDURES
.Cells(l, 7).Borders(xlDiagonalDown).LineStyle = xlLineStyleNone
.Cells(l, 7).Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
.Cells(l, 7).Borders(xlEdgeLeft).LineStyle = xlLineStyleNone
.Cells(l, 7).Borders(xlEdgeTop).LineStyle = xlLineStyleNone
.Cells(l, 7).Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
.Cells(l, 7).Borders(xlEdgeRight).LineStyle = xlLineStyleNone
.Cells(l, 7).Borders(xlInsideVertical).LineStyle = xlLineStyleNone
.Cells(l, 7).Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone
End If
Next l
End With
End Sub

Sub bordure()
With Worksheets("Stock Indutherms")

'Tableau 1
For b = 4 To .Range("a4").End(xlDown).Row
If .Cells(b, 7) <= .Cells(b, 8) Then
'TABLEAU 1 METTRE EN BORDURE ROUGE
With .Cells(b, 7).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Color = -16776961
.TintAndShade = 0
.Weight = xlMedium
End With
With .Cells(b, 7).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Color = -16776961
.TintAndShade = 0
.Weight = xlMedium
End With
With .Cells(b, 7).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = -16776961
.TintAndShade = 0
.Weight = xlMedium
End With
With .Cells(b, 7).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Color = -16776961
.TintAndShade = 0
.Weight = xlMedium
End With
End If
Next b
End With

End Sub

Sub essai_supression()
Application.ScreenUpdating = False
Worksheets("Entrée Matière").Activate

Dim ligin As Long, ligai As Long
ligai = 5000
For ligin = ligai To 1 Step -1
If Worksheets("Entrée Matière").Cells(ligin, 1).Value = "" Then
Rows(ligin).Delete
End If
Next
Application.ScreenUpdating = True
End Sub
#
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Essayez :
VB:
If IsEmpty(Worksheets("Entrée Matière").Cells(ligin, 1).Value) Then
Notez que c'est un code long à exécuter. On devrait tout pouvoir effectuer en une seule instruction
['Entrée Matière'!A1:A5000].SpecialCells(CellsTypeBlank).EntireRow.Delete
 

BENAM69

XLDnaute Occasionnel

Je suis novice sur VBA, j'essaye de me débrouiller comme je peux pour coder ^^.

En tout cas je te remercie pour ta solution. J'ai réussi à résoudre mon problème entre temps. Ce n'était pas un problème de formule VBA. C'était le contenu de mes cellules qui faussaient mon code. Dranreb, encore merci pour ton retour ^^
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…