automatisation via VBA pour un fichier hebdomadaire

Version imprimable

12/02/2018, 12h32
max452

1 pièce(s) jointe(s)

automatisation via VBA pour un fichier hebdomadaire

Bonjour à tous,

étant assez novice sur excel (j'ai déjà fait quelques macro plutôt légères), j'aurai besoin de savoir s'il est possible d'avoir un onglet sur lequel on entre des données et que ces données soient enregistré dans un autre onglet dans lequel, en fonction de la référence, un autre identification se met en place. Toutes les infos sont sur le 2ème onglet. A ce jour, je fait tout manuellement, le but est de gagner du temps.
Cf pièce jointe.

Merci d'avance.
12/02/2018, 13h49
halaster08

Bonjour,

Tu devrais lire ceci: fichier-joint-vos-discussions

Citation:

Envoyé par max452

A ce jour, je fait tout manuellement.

Si tu sais déjà le faire à la main alors l'enregistreur de macro te donnera 90% du code:tutoriels/excel-enregistreur-macro/
12/02/2018, 14h00
max452

Tout d'abord merci de m'avoir lu. Par contre l'enregistrement de macro doit marcher mais à adapter pour la condition type 1 ou type 2. Et là, j'ai tendance à craindre un peu sans compter que sur la page 1, il m'en faudrait une pour choisi via menu déroulant le type et le n° afin de pouvoir le charger sur cette feuille.
12/02/2018, 15h22
halaster08

Je maintiens ma réponse précédente, si tu sais le faire à la main l'enregistreur de macro te donnera la majeure partie du code, après à toi de rajouter des conditions et/ou des boucles.
12/02/2018, 15h27
max452

Je vais le faire et si jamais, je mettrais la nouvelle version en ligne.
Par contre pour la première partie qui consiste à mettre le type (via menu déroulant - sa je sais faire) et le n° et cliquer sur charger pour qu'il apparaisse dans l'onglet suivant (par exemple), c'est possible de m'aider ?
12/02/2018, 15h39
halaster08

Citation:

Par contre pour la première partie qui consiste à mettre le type (via menu déroulant - sa je sais faire) et le n° et cliquer sur charger pour qu'il apparaisse dans l'onglet suivant (par exemple), c'est possible de m'aider ?

Etant donné que tu n'as toujours pas exposé clairement ton problème, ni aucun code, non je ne peux pas t'aider plus.
12/02/2018, 17h37
max452

1 pièce(s) jointe(s)

Je patauge vraiment même au niveau de l'enregistrement macro car habituellement, je n'ai pas autant de variable.
J'ai l'impression de ne pas réussir à m'organiser pour faire cela dans le bon ordre.
12/02/2018, 21h09
halaster08

J'insiste:

Citation:

Envoyé par halaster08

Tu devrais lire ceci: fichier-joint-vos-discussions
13/02/2018, 01h04
kiki29

Salut, à voir : Excel et l'enregistreur de macro
Utiliser les UserForm en VBA Excel
Utiliser les contrôles dans un UserForm, en VBA Excel

sans compter tous les tutos

1 pièce(s) jointe(s)

code vba

bonjour

Code:

1
2
3
4
5
6
7
8
9
10
' Retourne la dernière ligne d'une plage de cellule
Public Function GetLastLineInRange(plage As Range) As Long
    Dim col As Long
    GetLastLineInRange = plage.Row
    For col = plage.Column To (plage.Column + plage.Columns.Count - 1)
        Dim foundLine As Long
        foundLine = plage.Worksheet.Cells(Rows.Count, col).End(xlUp).Row
        If foundLine > GetLastLineInRange Then GetLastLineInRange = foundLine
    Next col
End Function

Code:

1
2
3
4
5
6
7
8
9
10
 
Public Sub TEST()
With Worksheets("feuil1")
    If .FilterMode = True Then .ShowAllData
End With
With Worksheets("feuil1")
       Call deplacedonne(Sheets("Fichier  à renseigner"), Worksheets(.Name), 2, 2, 1, "X", GetLastLineInRange(.Range("a1:b1")), "x", "ag")
    End With
MsgBox "fin transfert"
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Sub deplacedonne(wsSource As Worksheet, wsDest As Worksheet, colonne As Integer, ByVal nbCol As Integer, colonnedest As Integer, choix, lastligne As Long, del_col1, del_col2)
Dim SourceLine
Dim type_ref
Dim destline As Long
Dim nbcount
nbcount = Cherche(Sheets("Fichier  à renseigner"), 1, ("a5"), Sheets("paramétre"), "1")
Dim lettre
lettre = Cherche(Sheets("Fichier  à renseigner"), 1, ("a5"), Sheets("paramétre"), "2")
Dim Désignation
Désignation = Cherche(Sheets("Fichier  à renseigner"), 2, ("b5"), Sheets("bdd"), "1")
Dim poid
poid = Cherche(Sheets("Fichier  à renseigner"), 2, ("b5"), Sheets("bdd"), "2")
Dim i
    destline = lastligne + 1
    For i = 1 To nbcount Step 1
            With wsSource.Cells(5, colonne).Resize(1, nbCol)
               .Copy wsDest.Cells(destline, colonnedest)
              nbCol = IIf(nbCol >= Columns.Count, Columns.Count - 1, nbCol)
               wsDest.Cells(destline, 3) = wsDest.Cells(destline, 2) + lettre
               wsDest.Cells(destline, 4) = wsDest.Cells(destline, 3) & "/" & i
               wsDest.Cells(destline, 6) = Désignation
               wsDest.Cells(destline, 7) = poid
               destline = destline + 1
            End With
 
    Next i
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Public Function Cherche(wsSource As Worksheet, col_recherche, cellule, wsbase As Worksheet, ajout_num_colonne As String)
'déclaration des variables :
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String, adressetrouvees As String
 
'********* à adapter ***********
'affectation de valeurs aux variables :
    'on cherche le mot "Trouve"
Valeur_Cherchee = wsSource.Range(cellule).Value
    'dans la première colonne de la feuille active
Set PlageDeRecherche = wsbase.Columns(col_recherche)
'*******************************
 
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
 
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
    'ici, traitement pour le cas où la valeur n'est pas trouvée
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
    'ici, traitement pour le cas où la valeur est trouvée
  Cherche = wsbase.Cells(Trouve.Row, (Trouve.Column + ajout_num_colonne))
End If
'MsgBox (adressetrouvees)
 
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Function

trouvez ci joint un fichier excel avec les modifications demande Pièce jointe 352201

cordialement
nicogef

07/03/2018, 16h46
max452

Merci beaucoup. :)