REPARTITION D'UNE BASE SUR PLUSIEURS FEUILLES (fonctionne mais trop long)

P

PASCAL84810

XLDnaute Junior
Boujour,

A partir d'une base de donnée "mouvement de stock" remontée de L'ERP, je vais créer un tableau de bord logistique
pour cela je sépare en "couper coller" dans un premier temps mes différents sites logistiques appelés dans ce cas MAS; LRM; D03; D06 sur une feuille pour chaque, MAS restant sur la feuille "BASE" (colonne 1 entete A1=site) (macro1).
Par la suite je sépare encore une fois la base avec copier coller (car cela va beaucoup plus vite que couper coller) suivant le type de mouvement (macro2).
j'ai donc récupéré sur le site et adapté une macro "couper coller", mais mon fichier fait entre 80000 et 200000 lignes et c'est du ligne par ligne donc super long, donc si vous avez plus simple et plus rapide je suis preneur.

Par la suite je transforme des formules avec le développeur pour remplir les cases de mon tableau, des données désirés, (suivant entre autre, de la colonne TRS qui donne des sous ensemble de transaction) "nombre de lignes livraisons, réceptions, mouvements de rangement par jour et par opérateur, etc.."

en vous remerciant
entête des colonnes
Site
ArtQtéQté UsPieceImputationDate CreatHeureOperateurTrsPiece OrigineType TransEmplPmp MoyenvALO AU pmp mOYTiersStatut StockDesig Mvt

Sub macro1()


Dim cell As Range
Sheets("LRM").Select
Cells.Select
Selection.Delete Shift:=xlUp


Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("A1:A" & Sheets("BASE").Range("A65536").End(xlUp).Row)
If cell.Value = "LRM" Then
cell.EntireRow.Cut Destination:=Sheets("LRM").Cells(Sheets("LRM").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("D06").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("A1:A" & Sheets("BASE").Range("A65536").End(xlUp).Row)
If cell.Value = "D06" Then
cell.EntireRow.Cut Destination:=Sheets("D06").Cells(Sheets("D06").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("D03").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("A1:A" & Sheets("BASE").Range("A65536").End(xlUp).Row)
If cell.Value = "D03" Then
cell.EntireRow.Cut Destination:=Sheets("D03").Cells(Sheets("D03").Range("A65536").End(xlUp).Row + 1, 1)
End If

Next

End Sub

__________________

macro2 'chaque page = un mouvement de la colonne L'

Sub Test()

Dim cell As Range
Sheets("CHANGEMEN").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("ENTREE DI").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("ENTREE OF").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("LIVRAISON").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("RECEPTION").Select
Cells.Select
Selection.Delete Shift:=xlUp

Sheets("RETOUR LI").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("SORTIE DI").Select
Cells.Select
Selection.Delete Shift:=xlUp

Sheets("SORTIE OF").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("TEMP").Select
Cells.Select
Selection.Delete Shift:=xlUp

Sheets("QNE").Select
Cells.Select
Selection.Delete Shift:=xlUp

Sheets("FACTURE MAG").Select
Cells.Select
Selection.Delete Shift:=xlUp


Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("L2:L" & Sheets("BASE").Range("L65536").End(xlUp).Row)
If cell.Value = "Changemen" Then
cell.EntireRow.Copy Destination:=Sheets("CHANGEMEN").Cells(Sheets("CHANGEMEN").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("L2:L" & Sheets("BASE").Range("L65536").End(xlUp).Row)
If cell.Value = "Sortie di" Then
cell.EntireRow.Copy Destination:=Sheets("sortie di").Cells(Sheets("sortie di").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("L2:L" & Sheets("BASE").Range("L65536").End(xlUp).Row)
If cell.Value = "Livraison" Then
cell.EntireRow.Copy Destination:=Sheets("LIVRAISON").Cells(Sheets("LIVRAISON").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("L2:L" & Sheets("BASE").Range("L65536").End(xlUp).Row)
If cell.Value = "Réception" Then
cell.EntireRow.Copy Destination:=Sheets("RECEPTION").Cells(Sheets("RECEPTION").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("L2:L" & Sheets("BASE").Range("L65536").End(xlUp).Row)
If cell.Value = "Entrée di" Then
cell.EntireRow.Copy Destination:=Sheets("ENTREE DI").Cells(Sheets("ENTREE DI").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("L2:L" & Sheets("BASE").Range("L65536").End(xlUp).Row)
If cell.Value = "Entrée OF" Then
cell.EntireRow.Copy Destination:=Sheets("ENTREE OF").Cells(Sheets("ENTREE OF").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("L2:L" & Sheets("BASE").Range("L65536").End(xlUp).Row)
If cell.Value = "Retour li" Then
cell.EntireRow.Copy Destination:=Sheets("RETOUR LI").Cells(Sheets("RETOUR LI").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("L2:L" & Sheets("BASE").Range("L65536").End(xlUp).Row)
If cell.Value = "Sortie OF" Then
cell.EntireRow.Copy Destination:=Sheets("SORTIE OF").Cells(Sheets("SORTIE OF").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next

Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("M2:M" & Sheets("BASE").Range("M65536").End(xlUp).Row)
If cell.Value = "TEMP" Then
cell.EntireRow.Copy Destination:=Sheets("TEMP").Cells(Sheets("TEMP").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("BASE").Select

For Each cell In Sheets("BASE").Range("M2:M" & Sheets("BASE").Range("M65536").End(xlUp).Row)
If cell.Value = "QNE" Then
cell.EntireRow.Copy Destination:=Sheets("QNE").Cells(Sheets("QNE").Range("A65536").End(xlUp).Row + 1, 1)
End If
Next
Sheets("FEUIL1").Select 'je récupère l’entête des colonnes copié sur la feuille 1 dans une autre macro'
Rows("1:1").Select
Selection.Copy
Sheets("CHANGEMEN").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("ENTREE DI").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("ENTREE OF").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("LIVRAISON").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("RECEPTION").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("RETOUR LI").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("SORTIE DI").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("SORTIE OF").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("FACTURE MAG").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("TEMP").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("QNE").Select
Range("A1").Select
ActiveSheet.Paste

End Sub
 
Trier par date Trier par votes
Efgé

Efgé

XLDnaute Barbatruc
Re : REPARTITION D'UNE BASE SUR PLUSIEURS FEUILLES (fonctionne mais trop long)

Bonjour PASCAL84810

Je ne sais pas si je pourrais t'aider, mais ce que je sais, c'est que sans un fichier exemple, annonyme, les réponses ne vont pas se faire légion :D

Cordialement
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : REPARTITION D'UNE BASE SUR PLUSIEURS FEUILLES (fonctionne mais trop long)

Re

Allez, jour de bonté :D
Une proposition, juste la feuille BASE, ensuite tout se crée
VB: 
Private Sub CommandButton1_Click()
Dim i&, J%
Dim Sh As Worksheet, TCol(1 To 2) As Integer

TCol(1) = 1: TCol(2) = 12 'Numéro des colonnes repères
Application.ScreenUpdating = False
With Sheets("BASE")
    For i = 2 To .Cells(.Rows.Count, 1).End(3).Row
        For J = LBound(TCol) To UBound(TCol)
            On Error Resume Next
            Set Sh = Sheets(.Cells(i, TCol(J)).Value)
            If Err Then
                Sheets.Add(After:=Sheets(Sheets.Count)).Name = .Cells(i, TCol(J)).Value
                Set Sh = Sheets(.Cells(i, TCol(J)).Value)
                .Range(.Cells(1, 1), .Cells(1, 18)).Copy Sh.Cells(1, 1)
                Err.Clear
            End If
            .Range(.Cells(i, 1), .Cells(i, 18)).Copy Sh.Cells(.Rows.Count, 1).End(3)(2)
        Next J
    Next i
    .Activate
End With

End Sub
Cordialement
 

Pièces jointes

  • Tri_Feuilles.xls
    27 KB · Affichages: 43
Vote positif 0 Vote négatif
P

PASCAL84810

XLDnaute Junior
Re : REPARTITION D'UNE BASE SUR PLUSIEURS FEUILLES (fonctionne mais trop long)

Merci, Efgé

par contre, je ne comprend pas comment cela fonctionne, peux tu définir quelques termes ou lignes ?
et je dois garder que site MAS dans ma base.
sinon,
voici un fichier xlsm joint, vidé des données de l'entreprise.

et encore merci
 

Pièces jointes

  • TABLEAU SUIVIT LOG (par mouv stock) - V2 - net.xlsm
    585.4 KB · Affichages: 53
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
Re : REPARTITION D'UNE BASE SUR PLUSIEURS FEUILLES (fonctionne mais trop long)

Re

Lance (en faisant Alt + F8) la macro TRI

Voici ce que fait ma proposition
Pour chaque site ET chaque "Type Trans" création d'une feuille avec l'en tete de la feuille Base.
Ton site MAS sera regroupé sur la feuille MAS

Le code est commenté.
J'ai supprimé tout ce qui n'a rien a voir avec le schmilblick (en particulier les codes qui n'ont rien a faire dans le ThisWorkBook


Comme je pense que ma solution ne te conviendras pas, je laisse d'autres prendre le relais.

C'est pour ça qu'il est toujours nécessaire de fournir un exemple avec la question (cela évite de se fourvoyer :D )

Cordaielemt
 

Pièces jointes

  • Tableau_Suivi_2.xls
    98.5 KB · Affichages: 55
Dernière édition:
Vote positif 0 Vote négatif
P

PASCAL84810

XLDnaute Junior
Re : REPARTITION D'UNE BASE SUR PLUSIEURS FEUILLES (fonctionne mais trop long)

re

merci c'est très claire, pour arriver à ce que je veux il faut que j'y rajoute une notion de couper et un ordre de déroulement des actions.
j'ai déjà essayé de mettre cut à la place de Copy dans les directives, mais en générale cela ne fait rien de bon a cause du décalage des lignes.
cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
203
Compte Supprimé 979
C
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
313
dadu35
D
cocro
  • Question
Microsoft 365 Créer autant d'onglet que de commune dans ma base principale
Réponses
14
Affichages
358
job75
job75
J
  • Résolu(e)
XL 2021 Boucler sur un combobox d'une feuille Excel (Pas un Usf)
Réponses
8
Affichages
475
jozerebel
J
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
95
Phil69970
Phil69970
A
  • Résolu(e)
XL 2016 Autofill Destination sur colonne adjacente
Réponses
3
Affichages
348
Aldonanou
A
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
482
Phil69970
Phil69970
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
544
Vermithor
V
R
  • Résolu(e)
XL 2019 macro couper-coller sur plusieurs onglets
Réponses
9
Affichages
488
job75
job75
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
215
guiyom
G

Membres actuellement en ligne

9 membres et 96 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 103
Messages
2 085 325
Membres
102 862
dernier inscrit
Emma35400