Transfert de données
silver.beach
-
silver.beach -
silver.beach -
Bonjour à tous,
J'utilise un formulaire de saisie (userform excel) avec des boutons, je souhaiterai que quand j'appui sur le bouton une information texte s'incrémente dans un autre fichier excel (base de données).
Le problème qui se pose c'est que a chaque fois que je clique sur un bouton, le fichier "Base de données" me marque:
" BaseDeDonnées.xls est déja ouvert. Si vous l'ouvrer à nouveau, toutes vos modifications seront perdues. Voulez-vous rouvrir BaseDeDonnées.xls ? "
Du coup je ne peux pas faire ma saisie complete !!
Voila le code que j'utilise :
'Copie des données service
Sub CopieDesDonnées(service)
Workbooks.Open "K:\Repertoire Commun\Arnaud\Excel\VBA\BaseDeDonnées.xls" 'Ouverture base de données
Application.ScreenUpdating = False
Workbooks("BaseDeDonnées").Activate
If Worksheets("Base de données").Range("B1").End(xlDown).Row > 65500 Then
Worksheets("Base de données").Range("B2").Value = service
Else
If Worksheets("Base de données").Range("A1").End(xlDown).Row = Worksheets("Base de données").Range("C1").End(xlDown).Row Then
Worksheets("Base de données").Range("B1").End(xlDown).Offset(1, 0).Value = service
Else
Worksheets("Base de données").Range("B1").End(xlDown).Value = service
End If
End If
Worksheets("Base de données").Activate
Application.ScreenUpdating = True
End Sub
J'utilise un formulaire de saisie (userform excel) avec des boutons, je souhaiterai que quand j'appui sur le bouton une information texte s'incrémente dans un autre fichier excel (base de données).
Le problème qui se pose c'est que a chaque fois que je clique sur un bouton, le fichier "Base de données" me marque:
" BaseDeDonnées.xls est déja ouvert. Si vous l'ouvrer à nouveau, toutes vos modifications seront perdues. Voulez-vous rouvrir BaseDeDonnées.xls ? "
Du coup je ne peux pas faire ma saisie complete !!
Voila le code que j'utilise :
'Copie des données service
Sub CopieDesDonnées(service)
Workbooks.Open "K:\Repertoire Commun\Arnaud\Excel\VBA\BaseDeDonnées.xls" 'Ouverture base de données
Application.ScreenUpdating = False
Workbooks("BaseDeDonnées").Activate
If Worksheets("Base de données").Range("B1").End(xlDown).Row > 65500 Then
Worksheets("Base de données").Range("B2").Value = service
Else
If Worksheets("Base de données").Range("A1").End(xlDown).Row = Worksheets("Base de données").Range("C1").End(xlDown).Row Then
Worksheets("Base de données").Range("B1").End(xlDown).Offset(1, 0).Value = service
Else
Worksheets("Base de données").Range("B1").End(xlDown).Value = service
End If
End If
Worksheets("Base de données").Activate
Application.ScreenUpdating = True
End Sub
A voir également:
- Transfert de données
- Fuite données maif - Guide
- Supprimer les données de navigation - Guide
- Whatsapp transfert discussion - Accueil - WhatsApp
- Trier des données excel - Guide
- Transfert de mail - Guide
2 réponses
Bonjour,
Ces lignes de code contrôlent si le classeur est ouvert et évite une nouvelle ouverture.
Remplacer la première ligne (juste après [Sub CopieDesDonnées(service)]) par ce bloc qui suit :
Salutations.
Le Pingou
Ces lignes de code contrôlent si le classeur est ouvert et évite une nouvelle ouverture.
Remplacer la première ligne (juste après [Sub CopieDesDonnées(service)]) par ce bloc qui suit :
Dim w As Variant
For Each w In Workbooks
If w.Name = "BaseDeDonnées.xls" Then
GoTo Ouvert
End If
Next w
Workbooks.Open "K:\Repertoire Commun\Arnaud\Excel\VBA\BaseDeDonnées.xls" 'Ouverture base de données
Ouvert:
Salutations.
Le Pingou