Probleme de transfert ligne d'un devis vers une autre feuille

jlp035

XLDnaute Occasionnel
Bonjour
J'ai récupéré et modifié un morceau de programme pour pouvoir copier les cases d'une ligne dans une feuille active dans le fichier G:\Travail\Bms\Projets\Liste des numero de devis\Montage projet\2.Facturation\02 410 15.xls .
Mais j'ai le messag 'incompabilité de type'.
quelqu'un à t'il une idée sur l'origine du probleme ?
Merci par avance
Jean-Luc

HTML:
Sub B_Transfert_De_Devis()
'
Dim Entree As Workbook
Dim Sortie As Workbook
Dim Nomfichierentree
Dim NomFichierSortie
'Chemin du classeur et f
Nomfichierentree = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
' On verifie que l'on a selectionné un nom de classeur
If Nomfichierentree <> False Then
NomFichierSortie = "G:\Travail\Bms\Projets\Liste des numero de devis\Montage projet\2.Facturation\02 410 15.xls"
   
 If NomFichierSortie <> False Then
        Set Sortie = Workbooks.Open(NomFichierSortie)
        Sortie.Worksheets("Feuil1").Range(20, 1) = Nomfichierentree("Liste Devis").Range(10, 1)
            
        ' On ferme le classeur
        Sortie.Close
        
    End If
    ' On ferme le second
    Entree.Close
 End If
End Sub
 

Paf

XLDnaute Barbatruc
Re : Probleme de transfert ligne d'un devis vers une autre feuille

Bonsoir,

a priori , modifier

Sortie.Worksheets("Feuil1").Range(20, 1) = Nomfichierentree("Liste Devis").Range(10, 1)
en
Sortie.Worksheets("Feuil1").Range(20, 1) = Nomfichierentree.Worksheets("Liste Devis").Range(10, 1)

d'autre part, à moins que Excel 2010 soit plus permissif que 2003, modifier Range(20, 1) en Range("T1") ou Cells(20,1), idem pour Range(10,1)

Par ailleurs,
1) dans
Code:
Nomfichierentree = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
' On verifie que l'on a selectionné un nom de classeur
If Nomfichierentree <> False Then
Nomfichierentree ne sera jamais false puisqu'il contiendra toujours le chemin et le nom du classeur actif
On peut donc supprimer le test
2)dans
Code:
NomFichierSortie = "G:\Travail\Bms\Projets\Liste des numero de devis\Montage projet\2.Facturation\02 410 15.xls"
If NomFichierSortie <> False Then
même remarque que 1)
il faudrait modifier en
NomFichierSortie = Dir("G:\Travail\Bms\Projets\Liste des numero de devis\Montage projet\2.Facturation\02 410 15.xls")
If NomFichierSortie <> False Then



Ajuster les End If en conséquence.

A+
 

jlp035

XLDnaute Occasionnel
Re : Probleme de transfert ligne d'un devis vers une autre feuille

Bonjour Paf,
Merci d'avoir pris le temps de regarder mon problème, mais apparemment cela ne suffit pas car j'ai maintenant le message "erreur d'exécution 424 "
La ligne suivante semble être le point de blocage:

NomFichierSortie.Sheets("Liste").Cells(20, 1) = Nomfichierentree.Worksheets("Liste Devis").Cells(10, 2)

Si tu a une solution je suis preneur.
Merci
 

Paf

XLDnaute Barbatruc
Re : Probleme de transfert ligne d'un devis vers une autre feuille

Re,

Pas tout vu.

a rajouter après les déclarations de variable
Code:
Set Entree = ActiveWorkbook


Remplacer
Code:
Set Sortie = Workbooks.Open(NomFichierSortie)
Sortie.Worksheets("Feuil1").Range(20, 1) = Nomfichierentree("Liste Devis").Range(10, 1)
par
Code:
Set Sortie = Workbooks.Open("G:\Travail\Bms\Projets\Liste des numero de devis\Montage projet\2.Facturation\02 410 15.xls")
Sortie.Sheets("Liste").Cells(20, 1) = Entree.Worksheets("Liste Devis").Cells(10, 2)


Supprimer
Code:
Nomfichierentree = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
' On verifie que l'on a selectionné un nom de classeur
If Nomfichierentree <> False Then

ça devrait aller

A+
 

jlp035

XLDnaute Occasionnel
Bonjour Paf,
Merci encore mai,j'ai essayer de reprendre tes bouts de programmes et j'ai du louper une étape car maintenant je n'ai plus d'erreur mais la copie transfert ne semble pas s'effectuer dans la feuille de sortie.
Ci joint le programme actualisé avec quelles remarques.

Code:
Sub B_Transfert_De_Devis()
'
Dim Entree As Workbook
Dim Sortie As Workbook
Dim Nomfichierentree
Dim NomFichierSortie
'
Set Entree = ActiveWorkbook
' pour essai futur
 '''Nomfichierentree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
    '
    If NomFichierSortie <> False Then
        '
        Set Sortie = Workbooks.Open("G:\Travail\Bms\Projets\Liste des numero de devis\Montage projet\2.Facturation\02 410 15.xls")
        'Transfert
        'Voir pour remplacer la ligne d'entre par la ligne 10 par celle pointée en index
        'Voir pour remplacer la ligne en sortie par la premiere ligne libre entre la ligne 1 et 26.
        
        Sortie.Sheets("Liste").Cells(20, 1) = Entree.Sheets("Liste Devis").Cells(10, 2)
        Sortie.Sheets("Liste").Cells(20, 2) = Entree.Worksheets("Liste Devis").Cells(10, 3)
        Sortie.Sheets("Liste").Cells(20, 3) = Entree.Worksheets("Liste Devis").Cells(10, 4)
         '
        Sortie.Close
         '
         ' On ferme le second
      Entree.Close
    End If
End Sub

Merci encore
Jean--Luc
 

Paf

XLDnaute Barbatruc
Re : Probleme de transfert ligne d'un devis vers une autre feuille

Re

Code:
Sub B_Transfert_De_Devis()
'
 Dim Entree As Workbook
 Dim Sortie As Workbook
 Dim Nomfichierentree
 Dim NomFichierSortie
'
 Set Entree = ActiveWorkbook
 ' pour essai futur
 ' Nomfichierentree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
    '
 If  Dir("G:\Travail\Bms\Projets\Liste des numero de devis\Montage projet\2.Facturation\02 410 15.xls") <> "" Then
        Set Sortie = Workbooks.Open("G:\Travail\Bms\Projets\Liste des numero de devis\Montage projet\2.Facturation\02 410 15.xls")
        'Transfert
        'Voir pour remplacer la ligne d'entre par la ligne 10 par celle pointée en index
        'Voir pour remplacer la ligne en sortie par la premiere ligne libre entre la ligne 1 et 26.
       
        Sortie.Sheets("Liste").Cells(20, 1) = Entree.Sheets("Liste Devis").Cells(10, 2)
        Sortie.Sheets("Liste").Cells(20, 2) = Entree.Worksheets("Liste Devis").Cells(10, 3)
        Sortie.Sheets("Liste").Cells(20, 3) = Entree.Worksheets("Liste Devis").Cells(10, 4)
         '
        
        Sortie.Close True ' ferme et enregistre le classeur
         '
         ' On ferme le second
         Entree.Close
 Else
       MsgBox "Fichier non trouvé"
 End If
End Sub
'Voir pour remplacer la ligne d'entre par la ligne 10 par celle pointée en index

Pas compris le besoin exact
Voir pour remplacer la ligne en sortie par la premiere ligne libre entre la ligne 1 et 26.
Y a-t-il des données à partie de la ligne 27?

A+
 

jlp035

XLDnaute Occasionnel
Re : Probleme de transfert ligne d'un devis vers une autre feuille

Bonjour Paf,
Maintenant que tu a ajouté la Msg, j'ai le message "fichier non trouver" mais je ne sais pas pourquoi il ne trouve pas le fichier ( a moins que le chemin ne soit trop long?).

Pour le message 'Voir pour remplacer la ligne d'entre par la ligne 10 par celle pointée en index' je souhaiterai que la ligne que j'ai pointer dans la feuille d'entrée "Liste devis" soit transférée après appuis sur un Bouton (qui existe déjà)vers la feuille de sortie "G:\Travail\Bms\Projets\Liste des numéro de devis\Montage projet\2.Facturation\02 410 15.xls".

Pour le message 'Voir pour remplacer la ligne en sortie par la première ligne libre entre la ligne 3 et 26'
C'est parce que j'ai déjà des lignes a partir de la ligne 27.

Merci par avance
Jean-Luc
 

Paf

XLDnaute Barbatruc
Re : Probleme de transfert ligne d'un devis vers une autre feuille

Re bonjour

pour le fichier non trouvé, vous êtes le seul à pouvoir vérifier que les répertoires et le fichier existent bien.

Pour copier la ligne "pointée" du fichier entrée vers la première ligne libre entre 1 (ou 3) et 26 du fichier sortie:

Code:
LigLibre = Sortie.Sheets("Liste").Range("A27").End(xlUp).Row + 1

Entree.Sheets("Liste Devis").Rows(ActiveCell.Row).Copy Sortie.Sheets("Liste").Range("A" & LigLibre)
à mettre à la place des 3 lignes Sortie.Sheets("Liste").....


A+
 

Discussions similaires

Statistiques des forums

Discussions
313 274
Messages
2 096 750
Membres
106 738
dernier inscrit
Lacbus