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

[jlp035]

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

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]

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

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

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]

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]

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

Set Entree = ActiveWorkbook

Remplacer

Set Sortie = Workbooks.Open(NomFichierSortie)
Sortie.Worksheets("Feuil1").Range(20, 1) = Nomfichierentree("Liste Devis").Range(10, 1)

par

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

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]

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.

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]

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

Re

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]

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]

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:

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+

 

[jlp035]

Re : Probleme de transfert ligne d'un devis vers une autre feuille (resolu)

Merci pour ta prompte réponse.
J'ai un peu modifié et cela fonctionne.
Je pense à la suite des problèmes
Merci encore.
Jean-luc