Suppression de lignes et ventilation de données

fouggy

XLDnaute Junior
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.
 

Pièces jointes

  • Action1 Résultat Attendu.xlsx
    38.3 KB · Affichages: 17
  • Action2 Résultat Attendu.xlsx
    28.1 KB · Affichages: 14

fouggy

XLDnaute Junior
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

XLDnaute Junior
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 :) :) :)
 

Pièces jointes

  • Action1 Résultat Attendu.xlsx
    39 KB · Affichages: 16
  • Action2 Résultat Attendu.xlsx
    28.7 KB · Affichages: 11

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir fouggy,

Un essai via le code ci-dessous :
VB:
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
 

Pièces jointes

  • fouggy- Action 1 et 2- v1a.xlsm
    51.9 KB · Affichages: 18
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 907
Membres
101 836
dernier inscrit
karmon