Envoi donnees d`un fichier a un autre ouvert

M

MOI

Guest
Bonsoir, c`est MOI

J`ai besoin de toi pour un probleme d`envoie de donnees.

J`ai un file ouvert avec des infos saisies ds des cellules specifiques et je veux envoyer ces infos ds un tableau situe ds un autre fichier les infos devant se mettre ligne par ligne.

Je recois + de 100 fichiers identiques et je dois copier ces infos donc une macro est la solution.

Alors je fais appel encore une fois au XLD people.

Ci-joint un fichier qui je l`espere est assez clair -

Merci pour votre aide

MOI [file name=envoiedonneesdsfileopen.zip size=7115]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/envoiedonneesdsfileopen.zip[/file]
 

Pièces jointes

  • envoiedonneesdsfileopen.zip
    6.9 KB · Affichages: 10

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Bonjour MOI

un code à placer dans ton classeur final, à lancer quand la feuille source est affichée.
on peut le coupler avec des routines d'ouverture de fichiers mais fournis les feuilles exemples.

Cordialement, A+

Code:
Sub trans_donnees()
With ThisWorkbook.Sheets('Allocation_Country')
With .Range('A65536').End(xlUp).Offset(1, 0)
.Value = Range('B3').Value
.Offset(0, 1).Value = Range('B4').Value
If Range('B9').Value = 0 Then .Offset(0, 2).Value = 0 Else .Offset(0, 2).Value = Range('B9').Value
If Range('B8').Value = 0 Then .Offset(0, 3).Value = 0 Else .Offset(0, 3).Value = Range('B8').Value
If Range('B10').Value = 0 Then .Offset(0, 4).Value = 0 Else .Offset(0, 4).Value = Range('B10').Value
If Range('B11').Value = 0 Then .Offset(0, 5).Value = 0 Else .Offset(0, 5).Value = Range('B11').Value
End With
End With
With ThisWorkbook.Sheets('Allocation_Project')
With .Range('A65536').End(xlUp).Offset(1, 0)
.Value = Range('B3').Value
.Offset(0, 1).Value = Range('B4').Value
If Range('B14').Value = 0 Then .Offset(0, 2).Value = 0 Else .Offset(0, 2).Value = Range('B14').Value
If Range('B15').Value = 0 Then .Offset(0, 3).Value = 0 Else .Offset(0, 3).Value = Range('B15').Value
If Range('B16').Value = 0 Then .Offset(0, 4).Value = 0 Else .Offset(0, 4).Value = Range('B16').Value
If Range('B17').Value = 0 Then .Offset(0, 5).Value = 0 Else .Offset(0, 5).Value = Range('B17').Value
End With
End With
End Sub
[file name=envoiedonneesdsfileopen_2.zip size=10987]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/envoiedonneesdsfileopen_2.zip[/file]
 

Pièces jointes

  • envoiedonneesdsfileopen_2.zip
    10.7 KB · Affichages: 13
M

MOI

Guest
Salut, je reviens.

J'ia pris ton code et j'essai d'joauter que si loe Nom saisi en B3 n'appartient pas à une liste ('Nom_Staff') située ds le fichier de destination Workbook ('Gestion_Personnel').Worksheets('Liste_Staff') (colonne B2:B1000 pour info), alors les données ne sont pas envoyées

j'ai donc corrige un peu le code mais ça veut pas marcher

Sub CommandButton1_Click()

Dim Liste_Staff() As String
Dim Trouver As Boolean

If Range('B3').Value = '' Then
MsgBox 'Pas de Nom de Famille, donc il n'y a rien à exporter, arrêt de la macro !', vbCritical + vbOKOnly, 'Erreur...'
Exit Sub 'la je dis si pas de nom rien ne s'envoie pour eviter pb
End If

If Range('B3').Value = ('Nom_Staff') Then
'ici si la value en B3 appartient à la liste ('Nom_Staff') alors j'envoie
With ThisWorkbook.Sheets('Allocation_Country')
With .Range('A65536').End(xlUp).Offset(1, 0)
.Value = Range('B3').Value
.Offset(0, 1).Value = Range('B4').Value
If Range('B9').Value = 0 Then .Offset(0, 2).Value = 0 Else .Offset(0, 2).Value = Range('B9').Value
If Range('B8').Value = 0 Then .Offset(0, 3).Value = 0 Else .Offset(0, 3).Value = Range('B8').Value
If Range('B10').Value = 0 Then .Offset(0, 4).Value = 0 Else .Offset(0, 4).Value = Range('B10').Value
If Range('B11').Value = 0 Then .Offset(0, 5).Value = 0 Else .Offset(0, 5).Value = Range('B11').Value
End With
End With
With ThisWorkbook.Sheets('Allocation_Projet')
With .Range('A65536').End(xlUp).Offset(1, 0)
.Value = Range('B3').Value
.Offset(0, 1).Value = Range('B4').Value
If Range('B14').Value = 0 Then .Offset(0, 2).Value = 0 Else .Offset(0, 2).Value = Range('B14').Value
If Range('B15').Value = 0 Then .Offset(0, 3).Value = 0 Else .Offset(0, 3).Value = Range('B15').Value
If Range('B16').Value = 0 Then .Offset(0, 4).Value = 0 Else .Offset(0, 4).Value = Range('B16').Value
If Range('B17').Value = 0 Then .Offset(0, 5).Value = 0 Else .Offset(0, 5).Value = Range('B17').Value
End With
End With

MsgBox 'Les données ont été envoyées avec succès !'

'si le terme en B3 n'est pas ds la range ('Nom_Staff') de la feuille'Liste_Staff' alors message 'ce nom n'est pas ds la liste, veuillez l'ajouter'

End If


End Sub


Bref c'est pas méchant je pense mais je cale!

Ah les boucles j'y travaille mais à chaque cas particulier, je plante

Merci si tu peux m'aider sur ce pb.

Sinon merci pour le premier step super utile

a+

MOI
 

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Bonjour

pas testé mais cela devrait fonctionner

A+
Code:
Sub Trans_donnees()
Dim Liste_Staff As Variant, Compteur As Long, Test As Boolean
With ThisWorkbook
    With .Worksheets('Liste_Staff')
        Liste_Staff = .Range('B2:B' & .Range('B65536').End(xlUp).Row).Value
    End With
    If Range('B3').Value = '' Then
        MsgBox 'Pas de Nom de Famille, donc il n'y a rien à exporter, arrêt de la macro !', vbCritical + vbOKOnly, 'Erreur...'
    Else
        Test = False
        For Compteur = LBound(Liste_Staff) To UBound(Liste_Staff)
        If StrComp(Range('B3').Value, Liste_Staff(Compteur, 1), 1) = 0 Then Test = True: Exit For
        Next Compteur
        If Test = True Then
            With .Sheets('Allocation_Country')
                With .Range('A65536').End(xlUp).Offset(1, 0)
                    .Value = Range('B3').Value
                    .Offset(0, 1).Value = Range('B4').Value
                    If Range('B9').Value = 0 Then .Offset(0, 2).Value = 0 Else .Offset(0, 2).Value = Range('B9').Value
                    If Range('B8').Value = 0 Then .Offset(0, 3).Value = 0 Else .Offset(0, 3).Value = Range('B8').Value
                    If Range('B10').Value = 0 Then .Offset(0, 4).Value = 0 Else .Offset(0, 4).Value = Range('B10').Value
                    If Range('B11').Value = 0 Then .Offset(0, 5).Value = 0 Else .Offset(0, 5).Value = Range('B11').Value
                End With
            End With
            With .Sheets('Allocation_Project')
                With .Range('A65536').End(xlUp).Offset(1, 0)
                    .Value = Range('B3').Value
                    .Offset(0, 1).Value = Range('B4').Value
                    If Range('B14').Value = 0 Then .Offset(0, 2).Value = 0 Else .Offset(0, 2).Value = Range('B14').Value
                    If Range('B15').Value = 0 Then .Offset(0, 3).Value = 0 Else .Offset(0, 3).Value = Range('B15').Value
                    If Range('B16').Value = 0 Then .Offset(0, 4).Value = 0 Else .Offset(0, 4).Value = Range('B16').Value
                    If Range('B17').Value = 0 Then .Offset(0, 5).Value = 0 Else .Offset(0, 5).Value = Range('B17').Value
                End With
            End With
            MsgBox 'Les données ont été envoyées avec succès !', vbOKOnly + vbInformation
        Else
            MsgBox 'ce nom n'est pas dans la liste, veuillez l'ajouter', vbOKOnly + vbInformation
        End If
    End If
End With
End Sub

Message édité par: yeahou, à: 10/02/2006 01:15
 

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
avec le fichier, testé cette fois
[file name=envoiedonneesdsfileopen_2_20060210011815.zip size=14093]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/envoiedonneesdsfileopen_2_20060210011815.zip[/file]
 

Pièces jointes

  • envoiedonneesdsfileopen_2_20060210011815.zip
    13.8 KB · Affichages: 8

Discussions similaires

Réponses
10
Affichages
359

Statistiques des forums

Discussions
312 498
Messages
2 088 997
Membres
104 001
dernier inscrit
dessinbecm