Copier coller entre deux classeurs

Bonsoir,

J'aimerais copier/coller des données d'un classeur à un autre. Pas de soucis pour interférer avec l'ouverture des classeurs, mais le code que j'ai créé fait bugger Excel, je n'arrive plus à faire arrêter le copiage dès la première cellule vide de la colonne A (dans le fichier exemple cellule A10, il ne faudrait pas que les données en dessous soit copiées).

Ci-joint un fichier Excel où la base se trouve sur la feuille 1 et l'export souhaité en page 2. Par mesure de confidentialité, je ne peux fournir les fichiers initiaux avec les macros déjà établies.

Merci à vous

Maurine,

Merci d'insérer sur ce forum les codes déjà établis, il ne doit rien y avoir de confidentiel dedans ou alors à remplacer par de fausses informations

@+

Bonjour,

Voici le début du code qui est incomplet, je me suis arrêté car ça faisait bugger Excel. Merci de votre aide.

Sub import()
Dim sFichier As String
Dim oShAcc As Worksheet
Dim oShExp As Worksheet
Dim oWBD As Workbook
Dim oShD As Worksheet
Dim bFin As Boolean
Dim iLig As Integer
Dim iCol As Integer
Dim iEcr As Integer
Dim iDerLig As Integer

Set oShAcc = ThisWorkbook.Worksheets("Accueil")
Set oShExp = ThisWorkbook.Worksheets("Export")

sFichier = Application.GetOpenFilename("Fichiers .xlsx,*.xlsx", , "Sélectionnez votre fichier (.xlsx)")
If UCase(sFichier) = "FAUX" Or UCase(sFichier) = "FALSE" Then
Exit Sub
End If

'efface
iDerLig = oShExp.Range("A" & Rows.Count).End(xlUp).Row

If iDerLig >= 4 Then
oShExp.Rows("4:" & iDerLig).ClearContents
End If

'ouvre données
Set oWBD = Workbooks.Open(sFichier, , True)
Set oShD = oWBD.Worksheets("Feuil1")

'parcours donnnées
bFin = False
iLig = 6
iEcr = 6

While Not bFin
If oShD.Range("A" & iLig).Value <> "Récapitulatif :" Then
bFin = True
Else
For iCol = 1 To 10
If oShD.Cells(iLig, iCol) <> 0 Then

oShExp.Range("A" & iEcr).Value = oShD.Range("A" & iLig).Value
iEcr = iEcr + 1
End If

Next iCol

End If

Wend

Set oShD = Nothing

oWBD.Close False
Set oWBD = Nothing

oShExp.Activate

MsgBox "Import terminé !", vbExclamation

Set oShAcc = Nothing
Set oShExp = Nothing

End Sub