pb enregistrement de copier coller d'un tableau à un tableau unique

[chris0405]

Bonjour à tous,

Je souhaite vous solliciter.

En effet, dans le cadre du travail, j'ai réalisé une maquette sur excel pour la gestion de clients.

Un fichier unique par client.


Ce que j'ai fait afin d'obtenir des statistiques c'est au moment ou il enregistre leur fichier cela écrit une ligne pour mon reporting dans un fichier unique pour tous les utilisateurs.

Le couac étant que si j'enregistre ma ligne au meme moment qu'une autre personne cela zappe une des 2 personnes or je precise dans mon code qu'à chaque ouverture de ce fichier il se place sur une case libre : Cells(65535, 1).End(xlUp)(2).Select

Auriez vous une astuce pour que le fichier enregistre en décalé si du coup en meme cela le bloque.

par ex : si erreur ou conflit recommence ton enregistrement jusqu'à l'aboutissement lol.

J'avoue que je sais pas trop écrire ca...🙁


Vous pourrez constater que j'ai essayé d'écrire, une ligne comme ça mais rien ne fait.

En bref, il faut bien qu'il concerve les 2 lignes saisie au meme moment et non l'écraser ou en préférer une. Il faut qu'elle soit à la suite dès qu'il y a un blanc meme si le fichier est partage et non enregistrer pour le moment.

Voir le code ci-dessous :
Sub incomplet()
'
' enregistrement Macro
' oui oui
'


Dim MaPlage As Range

Set MaPlage = Sheets("Source de données").Range("A2:AH2") 'Applique la plage voulue à la variable, changer le range pour changer la plage

MaPlage.Copy 'Fait la copie de la zone voulue

'ouvre le fichier concerné pour le collage

Workbooks.Open ("H:\Operateurs\SRC\08 - GDES\indemnisation\Statistiques\compilation NEO.xls")


selection:
Cells(65535, 1).End(xlUp)(2).Select


selection.PasteSpecial Paste:=xlPasteValues

On Error GoTo selection:

Application.DisplayAlerts = False

Cells(65535, 1).End(xlUp)(2).Select

ActiveWorkbook.Save

ActiveWorkbook.Close

End Sub



Merci à vous.

Dite-moi si je suis pas clair.C'est pas évident à expliquer.

merciiiii

Chris

 

[Paritec]

Re : pb enregistrement de copier coller d'un tableau à un tableau unique

Bonjour Chris0405 le forum
oui je pense que si tu testes si le fichier est ouvert alors tu fais un wait de 2 à 3 secondes puis un nouveau teste jusqu'à avoir le fichier fermé ce qui signifie que toi tu peux maintenant l'ouvrir.
Comme tu n'as pas mis de fichier exemple, je ne peux pas le modifier!!!
a+
papou 😱

 

[chris0405]

Re : pb enregistrement de copier coller d'un tableau à un tableau unique

merci pour ta réponse.

J'essaye de te l'envoyer demain.

Sinon, serais tu ecrire la condition qui dit si enregistreemnt ko recommence 2 secondes après. afin que j'essaye entre temps ?

Merkiiiiiiii à toi de répondre en tout cas

 

[chris0405]

Re : pb enregistrement de copier coller d'un tableau à un tableau unique

j'ai mis ca mais ca fonctionne toujours pas :'(
Sub incomplet()
'
Dim MaPlage As Range

Set MaPlage = Sheets("Source de données").Range("A2:AH2") 'Applique la plage voulue à la variable, changer le range pour changer la plage

MaPlage.Copy 'Fait la copie de la zone voulue

Application.DisplayAlerts = True
On Error Resume Next
Workbooks("H:\Operateurs\SRC\08 - GDES\indemnisation\Statistiques\compilation NEO.xls").Activate
If Err <> 0 Then
Workbooks.Open ("H:\Operateurs\SRC\08 - GDES\indemnisation\Statistiques\compilation NEO.xls")
Else: On Error GoTo Ouvert
End If

Cells(65535, 1).End(xlUp)(2).Select

selection.PasteSpecial Paste:=xlPasteValues

ActiveWorkbook.Save

ActiveWorkbook.Close

Exit Sub

Ouvert:
Application.Wait Now + TimeValue("00:00:05")
Cells(65535, 1).End(xlUp)(2).Select

selection.PasteSpecial Paste:=xlPasteValues

ActiveWorkbook.Save
ActiveWorkbook.Close

 

[chris0405]

Re : pb enregistrement de copier coller d'un tableau à un tableau unique

Avec ca ca ne fonctionne toujours pas :'(
Sub incomplet()
'
Dim MaPlage As Range

Set MaPlage = Sheets("Source de données").Range("A2:AH2") 'Applique la plage voulue à la variable, changer le range pour changer la plage

MaPlage.Copy 'Fait la copie de la zone voulue

Application.DisplayAlerts = True
On Error Resume Next
Workbooks("H:\Operateurs\SRC\08 - GDES\indemnisation\Statistiques\compilation NEO.xls").Activate
If Err <> 0 Then
Workbooks.Open ("H:\Operateurs\SRC\08 - GDES\indemnisation\Statistiques\compilation NEO.xls")
Else: On Error GoTo Ouvert
End If

Cells(65535, 1).End(xlUp)(2).Select

selection.PasteSpecial Paste:=xlPasteValues

ActiveWorkbook.Save

ActiveWorkbook.Close

Exit Sub

Ouvert:
Application.Wait Now + TimeValue("00:00:05")
Cells(65535, 1).End(xlUp)(2).Select

selection.PasteSpecial Paste:=xlPasteValues

ActiveWorkbook.Save
ActiveWorkbook.Close

 

[Paritec]

Re : pb enregistrement de copier coller d'un tableau à un tableau unique

Bonjour Chris405,
non ce que tu as fait ne peux pas fonctionner tu testes après les actions prévues sur ton fichier??
Pas bon il faut tester et si OK continuer la macro
a+
papou 😱

 

[Paritec]

Re : pb enregistrement de copier coller d'un tableau à un tableau unique

Re Bonjour Chris0405 le forum
voilà ta macro revue, et une fonction à ajouter en dessous de ta macro ou dans un module séparé comme tu le veux.
Mais la prochaine fois si tu n'as pas le temps de faire un petit classeur exemple, je ne prendrai pas le temps de te répondre non plus.
a+
papou 😱

Sub incomplet()
    Dim MaPlage As Range
    Set MaPlage = Sheets("Source de données").Range("A2:AH2")    'Applique la plage voulue à la variable, changer le range pour changer la plage
    MaPlage.Copy    'Fait la copie de la zone voulue
    Application.DisplayAlerts = True
1   If IsFileOpen("H:\Operateurs\SRC\08 - GDES\indemnisation\Statistiques\compilation NEO.xls") Then
   Application.Wait Now + TimeValue("00:00:05"): GoTo 1
   Else
   Workbooks.Open ("H:\Operateurs\SRC\08 - GDES\indemnisation\Statistiques\compilation NEO.xls")
   End If
    Cells(65535, 1).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub

Function IsFileOpen(ByVal strFic As String) As Boolean   'Forum des développeurs Caféine
    Dim fic As Integer
    On Error Resume Next
    fic = FreeFile()
    Open strFic For Input Access Read Lock Read Write As fic
    If Err.Number = 0 Then
        IsFileOpen = False
        Close fic
    Else
        IsFileOpen = True
    End If
End Function

 

[chris0405]

Re : pb enregistrement de copier coller d'un tableau à un tableau unique

merci bcp pour ta réponse je vais essayé j'ai reussi avec ca sinon regarde et dis moi ce que tu en penses :
Sub incomplet()
'
Dim MaPlage As Range

Set MaPlage = Sheets("Source de données").Range("A2:AH2") 'Applique la plage voulue à la variable, changer le range pour changer la plage

MaPlage.Copy 'Fait la copie de la zone voulue

Workbooks.Open ("H:\Operateurs\SRC\08 - GDES\indemnisation\Statistiques\compilation NEO.xls")

If ActiveWorkbook.ReadOnly = True Then
On Error GoTo Ouvert
End If
If ActiveWorkbook.ReadOnly = False Then
Cells(65535, 1).End(xlUp)(2).Select
selection.PasteSpecial Paste:=xlPasteValues

ActiveWorkbook.Save
ActiveWorkbook.Close
End If

le reste de ma macro

Exit Sub

Ouvert:
Application.DisplayAlerts = False
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.Wait Now + TimeValue("00:00:01")
Call incomplet


End Sub