Suppression de lignes et ventilation de données

[fouggy]

Bonjour le Forum,

Un fichier excel contient plusieurs feuilles dont la 1re "Base", contient une base de données initiale qui a été copiée dans toutes les autres feuilles.
A la suite de cette copie, toutes les données de ces autres feuilles ont subies un traitement spécifique dont je dispose des codes.
Ces autres feuilles sont nombreuses (Plus de 800). Et c'est long, compte-tenu du nombre de données traitées mais cela est fait.
Ayant récupéré le résultat attendu du traitement des données de toutes ces feuilles, je souhaiterais créer une "Mise à Jour" permettant de ne pas avoir à traiter à nouveau et à chaque fois l'ensemble des données mais seulement les nouvelles, lesquelles doivent néanmoins être reliées aux dernières lignes des autres feuilles.

La première action consisterait donc à supprimer le maximum de lignes dans toutes les feuilles (sauf le fichier "Base") en fonction d'un critère posé.
Le critère : Dans toutes les feuilles à traiter, la colonne "H" contient une série de "0" & d'étoiles "*).
L'objectif, dans chaque feuille, va être de repérer la ligne contenant le dernier "0" dans sa colonne "H" afin de supprimer toutes les lignes précédentes.

La 2me action consisterait à copier dans toutes les feuilles existantes (quel que soit leur nom) et à la suite de la dernière ligne rencontrée, uniquement les lignes de données sélectionnées manuellement dans le fichier "Base".

En fichier joint le résultat attendu.

Merci à vous et bon dimanche.

 

[fouggy]

Bonjour le Forum,

Un fichier excel contient plusieurs feuilles dont la 1re "Base", contient une base de données initiale qui a été copiée dans toutes les autres feuilles.
A la suite de cette copie, toutes les données de ces autres feuilles ont subies un traitement spécifique dont je dispose des codes.
Ces autres feuilles sont nombreuses (Plus de 800). Et c'est long, compte-tenu du nombre de données traitées mais cela est fait.
Ayant récupéré le résultat attendu du traitement des données de toutes ces feuilles, je souhaiterais créer une "Mise à Jour" permettant de ne pas avoir à traiter à nouveau et à chaque fois l'ensemble des données mais seulement les nouvelles, lesquelles doivent néanmoins être reliées aux dernières lignes des autres feuilles.

La première action consisterait donc à supprimer le maximum de lignes dans toutes les feuilles (sauf le fichier "Base") en fonction d'un critère posé.
Le critère : Dans toutes les feuilles à traiter, la colonne "H" contient une série de "0" & d'étoiles "*).
L'objectif, dans chaque feuille, va être de repérer la ligne contenant le dernier "0" dans sa colonne "H" afin de supprimer toutes les lignes précédentes.

La 2me action consisterait à copier dans toutes les feuilles existantes (quel que soit leur nom) et à la suite de la dernière ligne rencontrée, uniquement les lignes de données sélectionnées manuellement dans le fichier "Base".

En fichier joint le résultat attendu.

Merci à vous et bon dimanche.

 

[fouggy]

Oupssssssssssss,

Un petit oubli de ma part. Les actions 1 & 2 doivent se faire dans toutes les feuilles QUI SUIVENT la feuille "Base", quelque soit leur nom.

En effet, existe une "Feuil1" qui précède la feuille "Base" et qui contient des résultats déjà obtenus à conserver.

En pièces jointes les fichiers de résultats attendus modifiés.

Merki 🙂 🙂 🙂

 

[mapomme]

Bonsoir fouggy,

Un essai via le code ci-dessous :

Sub SupprLignesEtCopie()
Dim wsh As Worksheet, derLig0&, xarea As Range
Dim Source As Range, laBas As Range, n&

Application.ScreenUpdating = False
With Worksheets("Base")
  .Activate
  Set Source = Intersect(Selection.EntireRow, .Range("a:h").EntireColumn)
End With
For Each wsh In ThisWorkbook.Worksheets
  If wsh.Index > Worksheets("Base").Index Then
    With wsh
      On Error Resume Next: derLig0 = 0
      derLig0 = Application.WorksheetFunction.Match(999, .Range("h:h"), 1)
      On Error GoTo 0
      If derLig0 > 1 Then .Rows(1).Resize(derLig0 - 1).Delete
      For Each xarea In Source.Areas
        n = .Cells(.Rows.Count, "a").End(xlUp).Row
        If n = 1 And .Cells(1, "a") = "" Then n = n - 1
        n = n + 1
        xarea.Copy .Cells(n, "a")
        .Columns(1).NumberFormat = "dd/mm/yyyy"
      Next xarea
    Application.Goto .Range("a1"), True
    End With
  End If
Next wsh
End Sub

edit : quelques modifs minimes -> v1a

 

[fouggy]

Yeeeeeeeeppppppppppp...

Slt Mapomme, ta codification est au top.

Un grand merci.

Bonne soirée 🙂 🙂 🙂