Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

copier "si" et insérer

1 réponse
Avatar
Daniel Pelletier
Bonsoir à tous

Dans cette macro j'ai deux groupe que je voudrait copier seulement
les ligne qui on une entré de data dans "F" (et "E" pour le deuxième.groupe)
et les insérer dans une autre feuille en A2 (Feuille"Base_Insp") (et
Feuille "Base" pour le deuxième.groupe)
.
Présentement je les copie tous et les colles a la ligne ("A12960") l'autre
feuille
et je fait un trie pour remonter les donné en haut de la page.(le trie ne
serais requis si insérer)

Merci

Sub enregistrer_insp()
'
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Dim l As Long, c As Integer, oblig As Label
ActiveSheet.Unprotect
oblig:
For c = 2 To 3
For l = 18 To 37
If Cells(l, c).Value <> "" Then
If Cells(l, 5) = "" Then
Range("E" & l).Value = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& l - 17 & vbNewLine _
& " saisissez la maintenant" _
& " ci dessous", "PRIORITÉ est obligatoire", , "5000",
"2000")
GoTo oblig
End If
End If
Next l
Next c
Sheets("Feuille_insp").Select
Range("h2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Range("b8:k13").Select '__________ Premier groupe a changer_______
Selection.Copy
Sheets("Base_Insp").Select
Range("b12995").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=1
Range("I13000").Select
ActiveWindow.SmallScroll ToRight:=-1
Range("b2:k13001").Select
Range("k13001").Activate
ActiveWindow.SmallScroll ToRight:=-1
Application.CutCopyMode = False
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("F2")
_
, Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Range("B1:H1").Select
Selection.AutoFilter
Range("I2").Select
ActiveWindow.SmallScroll ToRight:=-2
Sheets("Feuille_insp").Select
Range("m8:o13").Select '__________ Deuxième groupe a changer______
Selection.Copy
Range("i8").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("B18:N37").Select
Selection.Copy
Sheets("Base").Select
Range("A12960").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:=False
Range("A2:L13000").Select
Range("L13000").Activate
Application.CutCopyMode = False
Selection.Sort Key1:=Range("a2"), Order1:=xlAscending, Key2:=Range("k2")
_
, Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Range("A1:L1").Select '______________le reste de cette macro va
bien___________
Selection.AutoFilter
Selection.AutoFilter Field:=10, Criteria1:="="
Range("M24").Select
Sheets("Feuille_insp").Select
Application.Run "'Insp_St-Hyacinthe.xls'!effacer_insp"
Application.Run "'Insp_St-Hyacinthe.xls'!effacer_défec"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Windows("Insp_St-Hyacinthe.xls:2").Activate
Application.Run "'Insp_St-Hyacinthe.xls'!List_Date_historique"
Range("c18").Select
Sheets("Feuille_insp").Select
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.Run "'Insp_St-Hyacinthe.xls'!ReplaceFenêtre"
End Sub

1 réponse

Avatar
Daniel Pelletier
Bonsoir a tous
Je m'explique un peu plus

Comment copier et collé avec une condition (cellule non vide)
Merci

"Daniel Pelletier" a écrit dans le message de
news:eHB3A%
Bonsoir à tous

Dans cette macro j'ai deux groupe que je voudrait copier seulement
les ligne qui on une entré de data dans "F" (et "E" pour le
deuxième.groupe)

et les insérer dans une autre feuille en A2 (Feuille"Base_Insp") (et
Feuille "Base" pour le deuxième.groupe)
.
Présentement je les copie tous et les colles a la ligne ("A12960") l'autre
feuille
et je fait un trie pour remonter les donné en haut de la page.(le trie ne
serais requis si insérer)

Merci

Sub enregistrer_insp()
'
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Dim l As Long, c As Integer, oblig As Label
ActiveSheet.Unprotect
oblig:
For c = 2 To 3
For l = 18 To 37
If Cells(l, c).Value <> "" Then
If Cells(l, 5) = "" Then
Range("E" & l).Value = InputBox( _
"Il manque une PRIORITE en sur la ligne " _
& l - 17 & vbNewLine _
& " saisissez la maintenant" _
& " ci dessous", "PRIORITÉ est obligatoire", , "5000",
"2000")
GoTo oblig
End If
End If
Next l
Next c
Sheets("Feuille_insp").Select
Range("h2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks: > _

False, Transpose:úlse
Range("b8:k13").Select '__________ Premier groupe a changer_______
Selection.Copy
Sheets("Base_Insp").Select
Range("b12995").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
ActiveWindow.SmallScroll ToRight:=1
Range("I13000").Select
ActiveWindow.SmallScroll ToRight:=-1
Range("b2:k13001").Select
Range("k13001").Activate
ActiveWindow.SmallScroll ToRight:=-1
Application.CutCopyMode = False
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending,
Key2:=Range("F2")

_
, Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
Range("B1:H1").Select
Selection.AutoFilter
Range("I2").Select
ActiveWindow.SmallScroll ToRight:=-2
Sheets("Feuille_insp").Select
Range("m8:o13").Select '__________ Deuxième groupe a changer______
Selection.Copy
Range("i8").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:úlse
Range("B18:N37").Select
Selection.Copy
Sheets("Base").Select
Range("A12960").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks: > _

False, Transpose:úlse
Range("A2:L13000").Select
Range("L13000").Activate
Application.CutCopyMode = False
Selection.Sort Key1:=Range("a2"), Order1:=xlAscending,
Key2:=Range("k2")

_
, Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom
Range("A1:L1").Select '______________le reste de cette macro va
bien___________
Selection.AutoFilter
Selection.AutoFilter Field:, Criteria1:="="
Range("M24").Select
Sheets("Feuille_insp").Select
Application.Run "'Insp_St-Hyacinthe.xls'!effacer_insp"
Application.Run "'Insp_St-Hyacinthe.xls'!effacer_défec"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Windows("Insp_St-Hyacinthe.xls:2").Activate
Application.Run "'Insp_St-Hyacinthe.xls'!List_Date_historique"
Range("c18").Select
Sheets("Feuille_insp").Select
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.Run "'Insp_St-Hyacinthe.xls'!ReplaceFenêtre"
End Sub