Modif de code ?

Bonjour,

je souhaite si possible que le code ci-dessous commence en A1 et B1 et non en A2 et B2 ?

j'ai essayé de bidouiller mais sans effet.....

Merci d'avance.

Sub ValidationFinale()

Worksheets("Web").Range("A1:B1000").ClearContents

Dim li As Long, dl As Long

li = Sheets("Liste complete").Range("I" & Rows.Count).End(xlUp).Row

For i = 3 To li

    If Sheets("Liste complete").Range("N" & i) = "Oui" Then
        Sheets("Liste complete").Range("F" & i & ":" & "F" & i).Copy
        Sheets("Web").Select
        dl = Sheets("Web").Range("A" & Rows.Count).End(xlUp).Row + 1
        Range("A" & dl).Select
        ActiveSheet.Paste
    End If
    If Sheets("Liste complete").Range("N" & i) = "Oui" Then
        Sheets("Liste complete").Range("H" & i & ":" & "H" & i).Copy
        Sheets("Web").Select
        dl = Sheets("Web").Range("B" & Rows.Count).End(xlUp).Row + 1
        Range("B" & dl).Select
        ActiveSheet.Paste
    End If

Next i

End Sub

Bonjour,

ce serait plus simple avec un fichier test.

à première vue le décalage de ligne est ici :

dl = Sheets("Web").Range("A" & Rows.Count).End(xlUp).Row + 1

le fichier est gros et ce code travail en fonction d'autres...

J'ai essayé de modifier le +1 mais ca ne fonctionne pas:

si je l'enleve il écrit tout dans la mm cellule et en A1 donc ok mais il n’incrémente pas !!

voici un fichier d'exemple....

bonjour,

Une solution :

Sub ValidationFinale()
Dim li As Long, dl As Long, ic&
Worksheets("02").Range("A1:B1000").ClearContents
li = Sheets("01").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To li
    If Sheets("01").Range("B" & i) = "Oui" Then
    ic = ic + 1
        Sheets("01").Range("A" & i & ":" & "A" & i).Copy Sheets("02").Range("A" & ic)
    End If
  Next i
End Sub

A+

parfait merci et bonne journée.

desolé mais j'ai encore une question comment fait tu pour rejouter des éléments "qualité et production" fonctionne j'ai rajouter "indicateur" ce qui fonctionne mais la recherche me fait de la mer...

il ne me donne pas les bonnes infos dans "indicateur"...

MErci d'avance....

  Dim MonDicoQualite As New Scripting.Dictionary
    Dim MonDicoProduction As New Scripting.Dictionary
    Dim MonDicoIndicateur As New Scripting.Dictionary
    Dim Tab_Donnees() As Variant
    Dim DrLigne&, Ligne&, DrColonne&, LigneOuEcrire&, Col_Service&, Cle$

DrLigne = Range("D" & Rows.Count).End(xlUp).Row
Range("D8:D" & DrLigne).ClearContents
Range("D8:D" & DrLigne).ClearFormats

'--------------------------------
LigneOuEcrire = 9
Col_Service = 2
DrLigne = Range("A" & Rows.Count).End(xlUp).Row
DrColonne = 2
ReDim Tab_Donnees(DrLigne, DrColonne)
Tab_Donnees = Range(Cells(1, 1), Cells(DrLigne, DrColonne)).Value
'--------------------------------

For Ligne = 1 To UBound(Tab_Donnees)
    If Tab_Donnees(Ligne, Col_Service) = "Qualité" Then
        Cle = Tab_Donnees(Ligne, 1)
        MonDicoQualite.Add Key:=Cle, Item:=Tab_Donnees(Ligne, 2)
    Else
        Cle = Tab_Donnees(Ligne, 1)
        MonDicoProduction.Add Key:=Cle, Item:=Tab_Donnees(Ligne, 2)

        Cle = Tab_Donnees(Ligne, 1)
        MonDicoIndicateur.Add Key:=Cle, Item:=Tab_Donnees(Ligne, 2)
    End If

Next Ligne

Application.ScreenUpdating = False
With Range("D8")
    .Value = "Production :"
    .Font.Bold = True
    .Font.Underline = True
End With

For Ligne = 0 To MonDicoProduction.Count - 1
    Range("D" & LigneOuEcrire) = MonDicoProduction.Keys(Ligne)
    Range("D" & LigneOuEcrire).Font.ColorIndex = 23
    Range("D" & LigneOuEcrire).Font.ColorIndex = 23
    LigneOuEcrire = LigneOuEcrire + 1
Next Ligne

With Range("D" & LigneOuEcrire)
    .Value = "Qualité :"
    .Font.Bold = True
    .Font.Underline = True
End With

LigneOuEcrire = LigneOuEcrire + 1

For Ligne = 0 To MonDicoQualite.Count - 1
    Range("D" & LigneOuEcrire) = MonDicoQualite.Keys(Ligne)
    Range("D" & LigneOuEcrire).Font.ColorIndex = 23
    LigneOuEcrire = LigneOuEcrire + 1
Next Ligne

With Range("D" & LigneOuEcrire)
    .Value = "Indicateur :"
    .Font.Bold = True
    .Font.Underline = True
End With

LigneOuEcrire = LigneOuEcrire + 1

For Ligne = 0 To MonDicoIndicateur.Count - 1
    Range("D" & LigneOuEcrire) = MonDicoIndicateur.Keys(Ligne)
    Range("D" & LigneOuEcrire).Font.ColorIndex = 23
    LigneOuEcrire = LigneOuEcrire + 1
Next Ligne

Application.ScreenUpdating = True

Set MonDicoQualite = Nothing
Set MonDicoProduction = Nothing
Set MonDicoIndicateur = Nothing
End Sub