Supprimer une ligne sur 2 en VBA

Le 09/02/2019 à 18:09

Bonsoir ,

Je ne trouve pas mon erreur dans mon code .

Je voudrais une fois le tableau Copier/coller en A366, lui supprimer une ligne sur deux à partir de la cellule A366.

Je vous met tout mon code , mais le problème viens exclusivement de la suppression des lignes demandées...(ça ne fonctionne pas...)

Sub extraction()
'
' extraction Macro
' extraire les données de la feuille stattunnel du fichier synoptique v3.
'
'
'

Dim chemin As String
Dim dernligne As Long

'faire la manipulation en arrière plan
       Application.ScreenUpdating = False

    'On ouvre le fichier synoptique v3
    chemin = "S:\...\Archives Stat Travaux"

    Workbooks.Open Filename:=chemin & "\synoptique v3 sauvegarde080219.xlsm"
    Sheets("Tunnel").Select

    'on fait apparaitre la feuille stattunnel
    Sheets("stattunnel").Visible = True

    'on sélectionne la feuille stattunnel
    Sheets("stattunnel").Select

    'on copie la plage de donnée
    Range("A3:BO732").Select
    Selection.Copy

   'Feuille extraction donnée
        'On active la feuille stattunnelextrac et on colle
        Windows("Extracteur de données v2.xlsm").Activate

        'on sélectionne la dernière ligne du tableau
         Sheets("stattunnelextrac").Range("A366").Select

        'on colle les données
         ActiveSheet.Paste

        'on supprime une ligne sur deux du tableau a partir de A366
        '?????????????
       dernligne = Range("A366") .select

      For i = 1 To dernligne Step -2
              Rows(i).EntireRow.Delete
Next

        'On sauvegarde
         ActiveWorkbook.Save

        'on ferme
         ActiveWorkbook.Close

End Sub

merci pour celui qui pourra m'éclairer

Le 09/02/2019 à 18:27

Salut

essaye ca :

Sub extraction()
'
' extraction Macro
' extraire les données de la feuille stattunnel du fichier synoptique v3.
'
'
'

Dim chemin As String
Dim dernligne As Long

'faire la manipulation en arrière plan
       Application.ScreenUpdating = False

    'On ouvre le fichier synoptique v3
    chemin = "S:\...\Archives Stat Travaux"

    Workbooks.Open Filename:=chemin & "\synoptique v3 sauvegarde080219.xlsm"
    Sheets("Tunnel").Select

    'on fait apparaitre la feuille stattunnel
    Sheets("stattunnel").Visible = True

    'on sélectionne la feuille stattunnel
    Sheets("stattunnel").Select

    'on copie la plage de donnée
    Range("A3:BO732").Select
    Selection.Copy

   'Feuille extraction donnée
        'On active la feuille stattunnelextrac et on colle
        Windows("Extracteur de données v2.xlsm").Activate

        'on sélectionne la dernière ligne du tableau
         Sheets("stattunnelextrac").Range("A366").Select

        'on colle les données
         ActiveSheet.Paste

        'on supprime une ligne sur deux du tableau a partir de A366
        '?????????????

      For i = 732 To 3 Step -3
              Rows(i).EntireRow.Delete
      Next

        'On sauvegarde
         ActiveWorkbook.Save

        'on ferme
         ActiveWorkbook.Close

End Sub
Le 09/02/2019 à 18:35

Bonjour,

proposition de correction à tester, car travail sans filet (=sans le fichier que tu as "oublié" de nous mettre)

Sub extraction()
'
' extraction Macro
' extraire les données de la feuille stattunnel du fichier synoptique v3.
'
'
'

    Dim chemin As String
    Dim dernligne As Long

    'faire la manipulation en arrière plan
    Application.ScreenUpdating = False
    Set awb = ThisWorkbook
    'On ouvre le fichier synoptique v3
    chemin = "S:\...\Archives Stat Travaux"

    Set wb = Workbooks.Open(Filename:=chemin & "\synoptique v3 sauvegarde080219.xlsm")

    'on fait apparaitre la feuille stattunnel
    wb.Sheets("stattunnel").Visible = True

    'on sélectionne la feuille stattunnel
    wb.Sheets("stattunnel").Range("A3:BO732").Copy awb.Sheets("stattunnelextrac").Range("A366")
    dernligne = awb.Sheets("stattunnelextrac").Cells(Rows.Count, 1).End(xlUp).Row
    If dernligne Mod 2 = 0 Then dernligne = dernligne + 1
    For i = dernligne To 367 Step -2
        awb.Sheets("stattunnelextrac").Rows(i).Delete
    Next

    'On sauvegarde
    ActiveWorkbook.Save

    'on ferme
    ActiveWorkbook.Close

End Sub
Le 09/02/2019 à 18:41

Salut

une correction

Sub extraction()
'
' extraction Macro
' extraire les données de la feuille stattunnel du fichier synoptique v3.
'
'
'

Dim chemin As String
Dim dernligne As Long

'faire la manipulation en arrière plan
       Application.ScreenUpdating = False

    'On ouvre le fichier synoptique v3
    chemin = "S:\...\Archives Stat Travaux"

    Workbooks.Open Filename:=chemin & "\synoptique v3 sauvegarde080219.xlsm"
    Sheets("Tunnel").Select

    'on fait apparaitre la feuille stattunnel
    Sheets("stattunnel").Visible = True

    'on sélectionne la feuille stattunnel
    Sheets("stattunnel").Select

    'on copie la plage de donnée
    Range("A3:BO732").Select
    Selection.Copy

   'Feuille extraction donnée
        'On active la feuille stattunnelextrac et on colle
        Windows("Extracteur de données v2.xlsm").Activate

        'on sélectionne la dernière ligne du tableau
         Sheets("stattunnelextrac").Range("A366").Select

        'on colle les données
         ActiveSheet.Paste

        'on supprime une ligne sur deux du tableau a partir de A366
        '?????????????

      For i = 1095 To 366 Step -3
              Rows(i).EntireRow.Delete
      Next

        'On sauvegarde
         ActiveWorkbook.Save

        'on ferme
         ActiveWorkbook.Close

End Sub
Le 09/02/2019 à 18:59

Re Bonsoir ,

Merci encore pour vos réponses , cependant je bloque toujours.

Je vais éviter de faire le boulet une deuxième fois et je vous met une partie de mes fichiers

Après je suis preneur de toutes modifications qui pourrais améliorer mes codes

Merci encore .

7extracteur-de-donnees-v3-seul.xlsm (902.20 Ko)
4synoptique-v3-sauvegarde090219.xlsm (244.63 Ko)
Le 09/02/2019 à 20:15

Merci AMIR

Mais ça ne fonctionne pas , le FOR NEXT reste en boucle...

Le 10/02/2019 à 00:28

Bonsoir,

code adapté grâce à tes fichiers

Sub extraction()
'
' extraction Macro
' extraire les données de la feuille stattunnel du fichier synoptique v3.
'
'
'

    Dim chemin As String
    Dim dernligne As Long

    'faire la manipulation en arrière plan
    Application.ScreenUpdating = False
    Set awb = ThisWorkbook
    'On ouvre le fichier synoptique v3
    chemin = "d:\downloads"

    Set wb = Workbooks.Open(Filename:=chemin & "\synoptique v3 sauvegarde090219.xlsm")

    'on fait apparaitre la feuille stattunnel
    wb.Sheets("stattunnel").Visible = True

    'on copie la feuille stattunnel vers stattunnelextrac
    wb.Sheets("stattunnel").Range("A3:BO732").Copy awb.Sheets("stattunnelextrac").Range("A366")
    dernligne = awb.Sheets("stattunnelextrac").Cells(Rows.Count, 1).End(xlUp).Row
    If dernligne Mod 2 = 0 Then dernligne = dernligne + 1
    For i = dernligne To 367 Step -2
        awb.Sheets("stattunnelextrac").Rows(i).Delete
    Next

    'On sauvegarde
    wb.Save

    'on ferme
    wb.Close

End Sub
Le 12/02/2019 à 15:21

Merci beaucoup h2so4 !!!

Tout fonctionne à merveille !

Rechercher des sujets similaires à "supprimer ligne vba"