Discussion :

[strkk]

Bonjour à tous,

Je travaille avec deux fichiers : - l'un en lecture seule qui est un formulaire à remplir pour passer demande (fichier A) - l'autre en lecture partagée pour consulter les demandes passées via le formulaire (fichier B)

Lorsque je suis sur mon fichier A, une fois mon formulaire rempli je valide la demande. J'ai écrit un code d'enregistrement de la demande (Macro Générale) qui est constitué de plusieurs "sous-macro" :
Macro 1 - contrôle des infos du formulaire
Macro 2 - copie des infos du formulaire pour le coller dans le fichier B
Macro 3- clean des infos du formulaire

Je rencontre 1 problème :

Il concerne la Macro 2 dont le code est à la suite, VBA m'affiche le message d'erreur d'exécution 13 incompatibilité de type pour la ligne que j'ai mis en gras. Ca bug en gros quand il s'agit de coller dans le fichier B la donnée du fichier A.

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub enregistrement_formulaire()

Dim rngSource As Range
Dim premiere_ligne As Long



With Worksheets("formulaire") 'fichier formulaire
    .Unprotect Password:="LEAN"
    
    Application.Calculate
   
  Set rngSource = Worksheets("formulaire").Range("U2:AE2")
  
 Call ouverture_BDD(wb) 'ouverture fichier base de donnée
 
  'COLLER DANS BASE DE DONNEES
  
  With wb.Sheets("bdd")
 
    
     premiere_ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1 'calcul de la première ligne vide
    
    On Error Resume Next
    .ShowAllData 'enlever tous les filtres de la base de données
    On Error GoTo 0
    
    .AutoFilter.Sort.SortFields.Clear
    .AutoFilter.Sort.SortFields.Add Key:= _
        Range("A6:A" & premiere_ligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal ' trier la base de données dans l'ordre croissant des numéros de demande
        With ActiveWorkbook.Worksheets("bdd").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        End With
    
    
    .Cells(premiere_ligne, 1).Value = .Cells(premiere_ligne - 1, 1).Value + 1 'Incrémentation du numéro de la demande
    .Range("B" & premiere_ligne).Resize(1, rngSource.Count).Value = rngSource.Value 'coller dans le fichier base de données la demande du fichier formulaire
    
    wb.Save
    
    wb.Close

End With

End With

Je m'en remets à vos conseils, j'ai toujours trouvé solution grâce a ce forum.

Merci d'avance

[Patrice740]

Bonjour,

T'es with sont plutôt en vrac !

Peut-être comme ça (non testé) :

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 enregistrement_formulaire()
Dim rngSource As Range
Dim premiere_ligne As Long
  With Worksheets("formulaire") 'fichier formulaire
    .Unprotect Password:="LEAN"
    Set rngSource = .Range("U2:AE2")
  End With
  Application.Calculate
  Call ouverture_BDD(wb) 'ouverture fichier base de donnée
  'COLLER DANS BASE DE DONNEES
  With wb.Worksheets("bdd")
    premiere_ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1 'calcul de la première ligne vide
    If .FilterMode Then .ShowAllData
    With .AutoFilter.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("A6"), SortOn:=xlSortOnValues, Order:=xlAscending     ' trier la base de données dans l'ordre croissant des numéros de demande
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    .Cells(premiere_ligne, 1).Value = .Cells(premiere_ligne - 1, 1).Value + 1 'Incrémentation du numéro de la demande
    .Range("B" & premiere_ligne).Resize(1, rngSource.Count).Value = rngSource.Value 'coller dans le fichier base de données la demande du fichier formulaire
    wb.Save
    wb.Close
  End With
End With

[strkk]

Merci pour cette proposition plus ordonnée et rectifiée de mon code. Je rencontre tout de même le même problème :/

[Patrice740]

RE,

Au lieu de

Code :

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

    .Range("B" & premiere_ligne).Resize(1, rngSource.Count).Value = rngSource.Value 'coller dans le fichier base de données la demande du fichier formulaire

mets :

Code :

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

    .Range("B" & premiere_ligne).Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value 'coller dans le fichier base de données la demande du fichier formulaire

[strkk]

J'ai essayé, ça me colle bien dans mon fichier B la donnée du fichier A. Par contre, la macro bug toujours à la même ligne avec le même message d'erreur

[Patrice740]

J'ai essayé, ça me colle bien dans mon fichier B la donnée du fichier A. Par contre, la macro bug toujours à la même ligne avec le même message d'erreur

C'est bien la ligne corrigée ?, tu dis que ça fonctionne mais il y a un message d'erreur ?

[strkk]

J'ai remplacé la ligne qui me fait défaut dans mon code par la ligne proposée. Le même message d'erreur apparaît pour la ligne à l'exécution du code.

Cependant, je n'ai peut être pas précisé au début mais malgré tout, à l'exécution du code ma ligne de données est bien collée du fichier A au fichier B mais avec le fameux message d'erreur qui stoppe la macro

[Patrice740]

J'ai remplacé la ligne qui me fait défaut dans mon code par la ligne proposée. Le même message d'erreur apparaît pour la ligne à l'exécution du code.
Cependant, je n'ai peut être pas précisé au début mais malgré tout, à l'exécution du code ma ligne de données est bien collée du fichier A au fichier B mais avec le fameux message d'erreur qui stoppe la macro

N'est pas plutôt la ligne au-dessus qui pose problème ?
Chez moi ce code fonctionne assez bien (même si la colonne A de la bdd contient du texte)

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
Option Explicit
Sub enregistrement_formulaire()
Dim rngSource As Range
Dim premiere_ligne As Long
Dim wb As Workbook
  With Worksheets("formulaire") 'fichier formulaire
    .Unprotect Password:="LEAN"
    Set rngSource = .Range("U2:AE2")
  End With
  Application.Calculate
  Call Ouverture_BDD(wb) 'ouverture fichier base de donnée
  'COLLER DANS BASE DE DONNEES
  With wb.Worksheets("bdd")
    If .FilterMode Then .ShowAllData
    premiere_ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1 'calcul de la première ligne vide
    With .AutoFilter.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("A6"), SortOn:=xlSortOnValues, Order:=xlAscending     ' trier la base de données dans l'ordre croissant des numéros de demande
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    .Cells(premiere_ligne, 1).Value = Val(.Cells(premiere_ligne - 1, 1).Value) + 1 'Incrémentation du numéro de la demande
    .Range("B" & premiere_ligne).Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value 'coller dans le fichier base de données la demande du fichier formulaire
    wb.Save
    wb.Close
  End With
End Sub