BUG dans un copier coller

[mfb]

Salut à tous.
Mon peu de connaissance en VBA m' oblige à venir troubler votre quiétude matinale.
Le petit fichier joint vous en dira + sur le PB renconté.
A dispo pour + de renseignements.
Que cela ne pertube néanmoins pas (trop) votre dimanche.
Merci par avance et A+ j' espère.
Daniel

[Bebere]

bonjour Mfb

essaye le code suivant pour copier/coller dans Transfert Dan

Sub Bouton4_QuandClic() 'Recopie dans "Transfert Dan"

Dim Nom As String

Nom = [A17].value
Workbooks.Open FileName:="E:\" & Nom & ".xls"

'Copie de "Sé Clé 1"
With ThisWorkbook.Sheets("Feuil1")
.Range("E13:I37").Copy Destination:=ActiveWorkbook.Sheets("Feuil1").Range ("E13")
End With

Range("A1").Select
ActiveWorkbook.Close SaveChanges:=True

'Retour Select en A1
Range("A1").Select

End Sub

à bientôt

[mfb]

Bonsoir Bébère.
J' ai installé ton code et .....SANS surprise ça MAAAAAAAAAAAAARCHE.
Ce code est un peu + long à réagir que celui d' import mais qu' importe le résultat est là c' est bien le principal.

Alors merci beaucoup et bonne soirée
A+
Daniel

[mfb]

Bonjour à tous et à toutes.
Désolé de revenir sur le sujet mais hier soir j' ai répondu un peu trop vite à Bébère car si le code proposé ne présente plus de BUG il copie les BLANCS et cela ne conviens pas à mon usage, alors ...... que faire?
A+
Daniel

[Bebere]

bonjour Mfb

est-ce ce que tu souhaites

Sub Bouton4_QuandClic()

Dim Nom As String, Plg As Variant, L As Integer, I As Integer, C As Byte
'Recopie dans "Transfert Dan"
Application.ScreenUpdating = False
'Copie de "Sé Clé 1"
With ThisWorkbook.Sheets("Feuil1")
Nom = .Range("A17").value
Plg = .Range("E13:I37")
End With


Workbooks.Open FileName:="E:\" & Nom & ".xls"
'1ère ligne
I = 13
For C = 1 To UBound(Plg, 2) 'colonnes
For L = 1 To UBound(Plg, 1) 'lignes
If Plg(L, C) <> "" Then
With ActiveWorkbook.Sheets("Feuil1")
.Cells(I, C + 4) = Plg(L, C)
End With
I = I + 1
End If
Next L
I = 13
Next C

Range("A1").Select

ActiveWorkbook.Close SaveChanges:=True

'Retour Select en A1
Range("A1").Select

Application.ScreenUpdating = True

End Sub

à bientôt

[mfb]

ReBonjour Bébère.
Le code que tu as proposé colle les blancs pour mon usage ça marche pas.
J'ai bidouillé le code Button4 en incluant TA boucle With et ça marche, car le fichier Transfert Dan se ferme après chaque opé alors lorsque que l' on réalise une opé Export après une opé Import ça gaze plus car le code du Button3 lui ne ferme pas Transfert Dan après chaque opé.
Alors y a t il une astuce pour modifier le code du Buuton3 permettant de fermer "transfert Dan" après chaque opé ?
Par ailleurs peut on réaliser l' enregistrement des modifs sur "Transfert Dan" en auto à chaque fermeture.
A+
Daniel

Sub Bouton4_QuandClic()
Dim Nom
'Copie de "Sé Clé 1"
Range("E13:I37").Select
Selection.Copy
'Recopie dans "Transfert Dan"
Nom = [A17].value
Workbooks.Open FileName:="E:\" & Nom & ".xls"
With ActiveWorkbook.Sheets("Feuil1")
Range("E13:I37").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Close
End With
'Retour Select en A1
ThisWorkbook.Activate
Sheets("feuil1").Select
Range("A1").Select
End Sub