Dysfonctionnent d'une macro qui efface et doit ensuite intégrer des données

Question

Bonjour à tou(te)s, Chère et Cher membre,

Je rencontre un problème avec une macro qui doit effacer des données dans un onglet appelé: "Jan-Déc", toutes les colonnes sauf les colonnes E, G, H, et I et à partir de la ligne 4 pour les autres colonnes.

Ensuite, il doit intégrer des données (certaines) de l'onglet: "BD_chantiers_N" dans l'onglet "Jan-Déc".

Mon problème est que les colonnes E, G, H, et I sont quand même effacées.

Je ne trouve pas le problème... auriez-vous une solution 🙏🏻

Je vous remercie infiniment.

*************************************

12suivi-chantiers-2025-test.zip (555.26 Ko)

6suivi-chantiers-2025-test.zip (555.26 Ko)

Sub MàJ_Données()

Dim i As Long, k As Long, DerLig As Long, lastRow As Long
Dim sourceData As Variant
Dim targetData() As Variant
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim targetRow As Long
Dim rowCount As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

' Initialisation des feuilles de travail
Set wsSource = Sheets("BD_chantiers_N")
Set wsTarget = ThisWorkbook.Sheets("Jan_Déc")

' Trouver la dernière ligne utilisée dans la feuille cible
lastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row

' Effacer les données des colonnes spécifiques à partir de la ligne 4
If lastRow >= 4 Then
wsTarget.Range("A4:A" & lastRow).ClearContents
wsTarget.Range("B4:B" & lastRow).ClearContents
wsTarget.Range("C4:C" & lastRow).ClearContents
wsTarget.Range("D4:D" & lastRow).ClearContents
wsTarget.Range("F4:F" & lastRow).ClearContents
wsTarget.Range("J4:J" & lastRow).ClearContents
wsTarget.Range("K4:K" & lastRow).ClearContents
wsTarget.Range("L4:L" & lastRow).ClearContents
wsTarget.Range("M4:M" & lastRow).ClearContents
wsTarget.Range("N4:N" & lastRow).ClearContents
wsTarget.Range("O4:O" & lastRow).ClearContents
wsTarget.Range("P4:P" & lastRow).ClearContents
wsTarget.Range("Q4:Q" & lastRow).ClearContents
wsTarget.Range("R4:R" & lastRow).ClearContents
wsTarget.Range("S4:S" & lastRow).ClearContents
wsTarget.Range("T4:T" & lastRow).ClearContents
End If

' Charger les données source dans un tableau
DerLig = wsSource.Range("B" & Rows.Count).End(xlUp).Row
sourceData = wsSource.Range("A2:AC" & DerLig).Value ' Charger toutes les colonnes nécessaires

' Initialiser la variable de ligne cible
k = 3
targetRow = 1 ' Correspond à la première ligne à remplir (A4)

' Compter le nombre de lignes à insérer
rowCount = 0
For i = 1 To UBound(sourceData, 1)
If sourceData(i, 29) = "EN COURS" Then
rowCount = rowCount + 1
End If
Next i

' Si nous avons des lignes à insérer
If rowCount > 0 Then
' Redimensionner le tableau cible pour contenir les données
ReDim targetData(1 To rowCount, 1 To 16) ' 16 colonnes à remplir (A à P)

' Remplir le tableau avec les données filtrées
targetRow = 1
For i = 1 To UBound(sourceData, 1)
If sourceData(i, 29) = "EN COURS" Then ' Si l'état est "EN COURS"
targetData(targetRow, 1) = sourceData(i, 4) ' Nom du chantier
targetData(targetRow, 3) = sourceData(i, 25) ' Appellation officielle
targetData(targetRow, 4) = sourceData(i, 15) ' Début évènement
targetData(targetRow, 6) = sourceData(i, 16) ' Fin évènement
targetData(targetRow, 10) = sourceData(i, 23) ' Classification
targetData(targetRow, 11) = sourceData(i, 1) ' ER
targetData(targetRow, 12) = sourceData(i, 19) ' Responsable chantier
targetData(targetRow, 13) = sourceData(i, 5) ' Informations complémentaires
targetData(targetRow, 14) = sourceData(i, 6) ' Ligne(s) concernée(s)
targetData(targetRow, 15) = sourceData(i, 10) ' Adresse(s) / Périmètre
targetData(targetRow, 16) = sourceData(i, 24) ' Impact Réseau

targetRow = targetRow + 1
End If
Next i

' Écrire les données dans la feuille en une seule fois
wsTarget.Range("A4:P" & 3 + rowCount).Value = targetData
End If

' Rétablir les paramètres de l'application
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

MsgBox "MàJ terminée avec succès!", vbExclamation

End Sub

edit moderation : code mis entre balise </> via bouton du menu d'édition du message, merci d'y penser à l'avenir.

h2so4 · Accepted Answer

Edit : Hello BsAlv une proposition sans trop modifier ton code. remplace cette partie-ci ' Si nous avons des lignes à insérer If rowCount &gt; 0 Then ' Redimensionner le tableau cible pour contenir les données ReDim targetData1(1 To rowCount, 1 To 4) ' 4 colonnes à remplir (A à D) ReDim targetData2(1 To rowCount, 1 To 1) ' 1 colonnes à remplir (F) ReDim targetData3(1 To rowCount, 1 To 7) ' 7 colonnes à remplir (J à P) ' Remplir le tableau avec les données filtrées targetRow = 1 For i = 1 To UBound(sourceData, 1) If sourceData(i, 29) = "EN COURS" Then ' Si l'état est "EN COURS" targetData1(targetRow, 1) = sourceData(i, 4) ' Nom du chantier targetData1(targetRow, 3) = sourceData(i, 25) ' Appellation officielle targetData1(targetRow, 4) = sourceData(i, 15) ' Début évènement targetData2(targetRow, 1) = sourceData(i, 16) ' Fin évènement targetData3(targetRow, 1) = sourceData(i, 23) ' Classification targetData3(targetRow, 2) = sourceData(i, 1) ' ER targetData3(targetRow, 3) = sourceData(i, 19) ' Responsable chantier targetData3(targetRow, 4) = sourceData(i, 5) ' Informations complémentaires targetData3(targetRow, 5) = sourceData(i, 6) ' Ligne(s) concernée(s) targetData3(targetRow, 6) = sourceData(i, 10) ' Adresse(s) / Périmètre targetData3(targetRow, 7) = sourceData(i, 24) ' Impact Réseau targetRow = targetRow + 1 End If Next i ' Écrire les données dans la feuille en une seule fois wsTarget.Range("A4:D" & 3 + rowCount).Value = targetData1 wsTarget.Range("F4:F" & 3 + rowCount).Value = targetData2 wsTarget.Range("J4:P" & 3 + rowCount).Value = targetData3 End If...

h2so4 · Answer

Le problème vient de cette ligne wsTarget.Range("A4:P" & 3 + rowCount).Value = targetData ton tableau targetData est chargé dans les colonnes A à P de ton tableau, mais il ne contient pas de valeur pour les colonnes E,G,H et I...

BsAlv · Answer

Sub MAJ_Donnees() Dim LO, Arr, aLignes Set LO = Range("tableau2").ListObject If LO.ListRows.Count Then LO.DataBodyRange.Delete Arr = Sheets("BD_Chantiers_N").Range("A1").CurrentRegion.Resize(, 30).Value2 ReDim aLignes(1 To UBound(Arr), 1 To 1) ptr = 0 For i = 2 To UBound(Arr) If StrComp(Arr(i, 29), "EN COURS", 1) = 0 Then ptr = ptr + 1: aLignes(ptr, 1) = i Next If ptr &gt; 0 Then Set c = LO.InsertRowRange With c.Cells(1).Resize(ptr) .Value = "x" .Value = Application.Index(Arr, aLignes, 4) ' Nom du chantier .Offset(, 2).Resize(, 2).Value = Application.Index(Arr, aLignes, Array(25, 15)) ' Appellation officielle & Début évènement .Offset(, 5) = Application.Index(Arr, aLignes, 16) ' Fin évènement .Offset(, 9).Resize(, 7).Value = Application.Index(Arr, aLignes, Array(23, 1, 19, 5, 6, 10, 24)) ' Classification, ER, Responsable chantier, Informations complémentaires, Ligne(s) concernée(s), Adresse(s) / Périmètre, Impact Réseau End With End If End Sub...