Supprimer ligne provenant d'une autre feuille
Bonjour,
J'ai un petit problème avec une macro. Ma macro prend des lignes sur une feuille selon une condition et les récopie sur une autre feuille. Cette partie fonctionne à merveille sauf que lorsque j'efface une ligne de ma première feuille, elle reste quand même sur la deuxième feuille.
Voici à quoi ressemble ma macro:
Sub DupliquerINSPECTION()
OptionCol(1) = 9
Dim i As Integer
For i = 2 To UBound(OptionCol)
OptionCol(i) = OptionCol(i - 1) + 2
Next i
Dim dupliLine As Long
Dim InputLine As Long
dupliLine = 8
InputLine = 2
Dim piece As String
piece = ""
While Worksheets("INSPECTION").Cells(InputLine, 3).Value <> ""
If Worksheets("INSPECTION").Cells(InputLine, 2).Value <> "" Then
piece = Worksheets("INSPECTION").Cells(InputLine, 2).Value
End If
If Worksheets("INSPECTION").Cells(InputLine, 7).Value <> "" Then
Call AddLine(piece, Worksheets("INSPECTION"), InputLine, Worksheets("RAPPORT"), dupliLine)
End If
InputLine = InputLine + 1
Wend
Sheets("RAPPORT").Activate
End Sub
Sub AddLine(piece As String, wsSource As Worksheet, InputLine As Long, wsTarget As Worksheet, targetLine As Long)
Dim ColI As Integer
With wsTarget
.Cells(targetLine, 3).Value = wsSource.Cells(InputLine, 4).Value
.Cells(targetLine, 2).Value = wsSource.Cells(InputLine, 3).Value
ActiveSheet.Unprotect Password:="RAPPORT"
.Cells(targetLine, 4).Value = piece
.Cells(targetLine, 5).Value = wsSource.Cells(InputLine, 5).Value
.Cells(targetLine, 7).Value = wsSource.Cells(InputLine, NotesColumn).Value
'.Cells(targetLine, 5).Value = wsSource.Cells(InputLine, NotesColumn).Value
'If .Cells(targetLine, 4).Value = "" Then .Cells(targetLine, 4).Value = .Cells(targetLine - 1, 4).Value
Call AddOptionsLines(wsSource, InputLine, wsTarget, targetLine)
End With
ActiveSheet.Protect Password:="RAPPORT"
End Sub
Sub AddOptionsLines(wsSource As Worksheet, InputLine As Long, wsTarget As Worksheet, targetLine As Long)
Dim targetLineAtBegin As Long
targetLineAtBegin = targetLine
With wsTarget
.Range(.Cells(targetLine, 2), .Cells(targetLine, 5)).Copy
Dim i As Integer
For i = 1 To UBound(OptionCol)
If wsSource.Cells(InputLine, OptionCol(i)).Value <> "" Then
.Cells(targetLine, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
.Cells(targetLine, 6).Value = wsSource.Cells(InputLine, OptionCol(i) - 1).Value
targetLine = targetLine + 1
End If
Next i
If targetLine = targetLineAtBegin Then
targetLine = targetLine + 1
End If
End With
End Sub
Sub Add()
Range("A7:J150").Select
ActiveSheet.Unprotect Password:="RAPPORT"
ActiveSheet.Range("$A$7:$A$150").AutoFilter Field:=1, Criteria1:="<>"
Columns("C:F").Select
Range("C8").Activate
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("H6:I6").Select
Range("B8:B150").Select
Selection.Cut
Range("T8").Select
ActiveSheet.Paste
Range("D8150").Select
Selection.Cut
Range("B8").Select
ActiveSheet.Paste
Range("T8:T150").Select
Selection.Cut
Range("D8").Select
ActiveSheet.Paste
Range("A8").Select
ActiveCell.FormulaR1C1 = "=ROW(R[-7]C:R[142]C)"
Range("A8").Select
Selection.AutoFill Destination:=Range("A8:A150"), Type:=xlFillDefault
Range("A8:A150").Select
Range("H8").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-6]=""0c"",""Réjean"",IF(RC[-6]=""17c"",R6C4,IF(RC[-6]=""60c"",""Stéphane"",IF(RC[-6]=""70c"",""Réal"",""""))))"
Range("H8").Select
Selection.AutoFill Destination:=Range("H8:H150"), Type:=xlFillDefault
Range("H8:H150").Select
ActiveWorkbook.Worksheets("RAPPORT").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("RAPPORT").AutoFilter.Sort.SortFields.Add Key:= _
Range("B7:B620"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("RAPPORT").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Protect Password:="RAPPORT"
End Sub
Bonsoir Steeve34 le forum
moi personnellement je ne répond pas à un post ou il y a 1 kilomètre de macro sans les balises de code, et surtout sans fichier avec les explications dedans
alors voilà si tu veux une réponse commence par apprendre a te servir des balises et joins un fichier anonymisé
a+
papou