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
#
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
#