Automatisation de l'Extraction de données dune feuille a d autre
Didiodas
Messages postés
3
Date d'inscription
Statut
Membre
Dernière intervention
-
Didiodas Messages postés 3 Date d'inscription Statut Membre Dernière intervention -
Didiodas Messages postés 3 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Je voudrais automatiser la sélection de certaines données pour compléter 4 autres feuilles excel mais je n'ai aucune idées de comment faire. je voudrais coder cela en vba
Je voudrais automatiser la sélection de certaines données pour compléter 4 autres feuilles excel mais je n'ai aucune idées de comment faire. je voudrais coder cela en vba
A voir également:
- Extraire des données d'un tableau excel vers un autre tableau
- Tableau word - Guide
- Trier un tableau excel - Guide
- Tableau ascii - Guide
- Imprimer un tableau excel - Guide
- Tableau croisé dynamique - Guide
1 réponse
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
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