Discussion :

[max452]

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.

[halaster08]

Bonjour,

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

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/

[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.

[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.

[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 ?

[halaster08]

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.

[max452]

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.

[halaster08]

J'insiste:

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

[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

[nicogef]

bonjour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 Copie de Essai (1).xlsm

cordialement
nicogef

[max452]

Merci beaucoup.