Automatisation de l'Extraction de données dune feuille a d autre
Fermé
Didiodas
Messages postés
3
Date d'inscription
mardi 28 novembre 2017
Statut
Membre
Dernière intervention
29 novembre 2017
-
Modifié le 28 nov. 2017 à 11:39
Didiodas Messages postés 3 Date d'inscription mardi 28 novembre 2017 Statut Membre Dernière intervention 29 novembre 2017 - 29 nov. 2017 à 15:06
Didiodas Messages postés 3 Date d'inscription mardi 28 novembre 2017 Statut Membre Dernière intervention 29 novembre 2017 - 29 nov. 2017 à 15:06
A voir également:
- Extraire des données d'un tableau excel vers un autre tableau
- Tableau croisé dynamique - Guide
- Tableau ascii - Guide
- Tableau word - Guide
- Comment imprimer un tableau excel sur une seule page - Guide
- Liste déroulante excel - Guide
1 réponse
Didiodas
Messages postés
3
Date d'inscription
mardi 28 novembre 2017
Statut
Membre
Dernière intervention
29 novembre 2017
Modifié le 28 nov. 2017 à 11:47
Modifié le 28 nov. 2017 à 11:47
voici le liens de mon fichier excel complet https://www.cjoint.com/c/GKCkrLH8Tuy
il faudrait au final que en cliquant sur le bouton extraire du formulaire les donnes de la feuille Importation se repartissent automatiquement dans les 4 autres feuilles
J ai fait un exemple en couleur du début du résultat souhaiter au final
Je pense a quelque chose de se genre la mais adapter a mon cas :
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Dim k As Double 'initialisation des variables
k = 2
Dim l As Double
l = 2
Dim m As Double
m = 2
'-----------------------------------------------------------
'nbcolonne1 = Sheets("MT535").UsedRange.Columns.Count 'compte le nombre de colonnes non vides sur la feuille 1
'nbligne1 = Sheets("MT535").UsedRange.Rows.Count 'compte le nombre de lignes non vides sur la feuille 1
'MT535.Activate 'On active la feuille 1 où l'on va appliquer le code
'-----------------------------------------------------------
'derniere cellule non vide colonne A: a adapter suivant
nbligne1 = Sheets("MT535").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To nbligne1 'boucle qui va nous faire parcourir toutes les lignes de la feuille1
If Left(Cells(i, 1).Value, 5) = ":35B:" Then 'Si le début de la cellule contient ":35B:"
Sheets("Traitement").Cells(k, 1).Value = Sheets("MT535").Cells(i, 1).Value 'Alors on copie la ligne
k = k + 1
ElseIf Left(Cells(i, 1).Value, 5) = ":19A:" Then
Sheets("Traitement").Cells(l, 3).Value = Sheets("MT535").Cells(i, 1).Value
l = l + 1
ElseIf Left(Cells(i, 1).Value, 10) = ":93B::AVAI" Then
Sheets("Traitement").Cells(m, 5).Value = Sheets("MT535").Cells(i, 1).Value
m = m + 1
End If
Next
'Traitement.Activate
End Sub
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Merci de votre aide
il faudrait au final que en cliquant sur le bouton extraire du formulaire les donnes de la feuille Importation se repartissent automatiquement dans les 4 autres feuilles
J ai fait un exemple en couleur du début du résultat souhaiter au final
Je pense a quelque chose de se genre la mais adapter a mon cas :
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Dim k As Double 'initialisation des variables
k = 2
Dim l As Double
l = 2
Dim m As Double
m = 2
'-----------------------------------------------------------
'nbcolonne1 = Sheets("MT535").UsedRange.Columns.Count 'compte le nombre de colonnes non vides sur la feuille 1
'nbligne1 = Sheets("MT535").UsedRange.Rows.Count 'compte le nombre de lignes non vides sur la feuille 1
'MT535.Activate 'On active la feuille 1 où l'on va appliquer le code
'-----------------------------------------------------------
'derniere cellule non vide colonne A: a adapter suivant
nbligne1 = Sheets("MT535").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To nbligne1 'boucle qui va nous faire parcourir toutes les lignes de la feuille1
If Left(Cells(i, 1).Value, 5) = ":35B:" Then 'Si le début de la cellule contient ":35B:"
Sheets("Traitement").Cells(k, 1).Value = Sheets("MT535").Cells(i, 1).Value 'Alors on copie la ligne
k = k + 1
ElseIf Left(Cells(i, 1).Value, 5) = ":19A:" Then
Sheets("Traitement").Cells(l, 3).Value = Sheets("MT535").Cells(i, 1).Value
l = l + 1
ElseIf Left(Cells(i, 1).Value, 10) = ":93B::AVAI" Then
Sheets("Traitement").Cells(m, 5).Value = Sheets("MT535").Cells(i, 1).Value
m = m + 1
End If
Next
'Traitement.Activate
End Sub
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Merci de votre aide
29 nov. 2017 à 15:06
Option Explicit
Sub rangecopy()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant
Set FL1 = Worksheets("Feuil2")
NoCol = 1 'lecture de la colonne 1
Range("A11, A12, A13, A14, A15, A16").Copy Feuil2.Range("B1")
Range("A11, A12, A13, A14, A15, A16").Copy Feuil3.Range("B1")
Range("A11, A12, A13, A14, A15, A16").Copy Feuil4.Range("B1")
Range("A11, A12, A13, A14, A15, A16").Copy Feuil5.Range("B1")
Range("A50, A51, A52").Copy Feuil2.Range("B7")
Range("A54, A55, A56").Copy Feuil3.Range("B7")
Range("A58, A59, A60").Copy Feuil4.Range("B7")
Range("A62, A63, A64").Copy Feuil5.Range("B7")
End Sub