Faire un copier coller sur la première ligne vide

Fermé

Sphinxitos - 15 juil. 2016 à 12:11
thev Messages postés 1852 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 23 avril 2024 - 15 juil. 2016 à 18:22

Bonjour,

Je suis en train d'adapter un code qui marche parfaitement sur un autre fichier Excel. Les modification que j'apporte doivent me permettre d'ouvrir un fichier grâce à l'explorateur Windows sélectionner le fichier copier des colonnes en fonction de leur intitulé et coller dans le ficher de destination. Jusque là aucun soucis car je sais coller les différentes colonnes à partir de la première ligne en écrasant les données existantes, mais ma tentative de coller sur la première ligne vide (à la suite des données existantes ne marche pas). Voici mon code:

Sub ImporterFacturation()
Dim Fichier, WbkCopy As Workbook, WbkColle As Workbook
Dim Colonnes(), Col As Integer, Resultat As Variant
Dim lastRow As Long

'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)
Set WbkColle = ThisWorkbook

lastRow = WbkColle.Sheets("Rapport CA").Cells(Cells.Rows.Count, 1).End(xlDown).Row

'A adapter : Nom des entêtes de colonnes à importer
Colonnes = Array("Blanket PO", "Invoice number", "Material Code sent", "Material Code returned", "Serial number sent", "Serial number returned", "Service executed", "Repair price", "Currency", "Delivery date", "Work order number", "Work order line number", "Repair Center Product Code", "VA Total", "MI Total")

'Sélection du fichier
Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")
'En cas de clic sur "ANNULER"
If Fichier <> False Then
'On ouvre le fichier en question
Set WbkCopy = Workbooks.Open(Fichier)
With WbkCopy.Sheets("Export") '==> ADAPTER NOM de la feuille
'Boucle sur toutes les entêtes des colonnes
For Col = 1 To .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
'teste si l'entête correspond à un des noms des colonnes à copier
Resultat = Application.Match(.Cells(1, Col), Colonnes, 0)
'Si l'entête est trouvée (colonne à copier)
If Not IsError(Resultat) Then
'Copié - Collé ==> ADAPTER NOM de la feuille ou coller ("Rapport CA" à remplacer)
.Columns(Col).Copy WbkColle.Sheets("Rapport CA").Cells(lastRow, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)
End If
Next Col
End With
WbkCopy.Close
End If
Set WbkCopy = Nothing
Set WbkColle = Nothing
End Sub

A voir également:

1 réponse

Réponse 1 / 1

thev Messages postés 1852 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 23 avril 2024 681
15 juil. 2016 à 18:22

Bonjour,

Essayer ce code


 Sub ImporterFacturation()

Dim Fichier, WbkCopy As Workbook, WbkColle As Workbook
Dim Colonnes(), Col As Integer, Resultat As Variant
Dim à_copier, cellule_début As Range


 'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)
 Set WbkColle = ThisWorkbook

 'A adapter : Nom des entêtes de colonnes à importer
 Colonnes = Array("Blanket PO", "Invoice number", "Material Code sent", "Material Code returned", "Serial number sent", "Serial number returned", "Service executed", "Repair price", "Currency", "Delivery date", "Work order number", "Work order line number", "Repair Center Product Code", "VA Total", "MI Total")

 'Sélection du fichier
 Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")
 'En cas de clic sur "ANNULER"
 If Fichier <> False Then
    'On ouvre le fichier en question
    Set WbkCopy = Workbooks.Open(Fichier)
    With WbkCopy.Sheets("Export").UsedRange '==> ADAPTER NOM de la feuille
        'Boucle sur toutes les entêtes des colonnes
        For Each colonne In .Columns   ' colonnes utilisées
            'teste si l'entête correspond à un des noms des colonnes à copier
            Resultat = Application.Match(colonne.Rows(1), Colonnes, 0)
            'Si l'entête est trouvée (colonne à copier)
            If Not IsError(Resultat) Then
                'Copié - Collé ==> ADAPTER NOM de la feuille ou coller ("Rapport CA" à remplacer)
                If Not à_copier Is Nothing Then
                    Set à_copier = Union(à_copier, colonne)
                Else
                    Set à_copier = colonne
                End If
            End If
        Next colonne
    End With
    
    ' copie à partir de la première cellule vide
    With WbkColle.Sheets("Rapport CA")
            Set cellule_début = .Columns("A").Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)   'première cellule vide
            If cellule_début Is Nothing Then Set cellule_début = .[A1] 'si feuille vierge, première cellule vide = A1
            à_copier.Copy cellule_début
    End With
    
    
    WbkCopy.Close
 End If

Set WbkCopy = Nothing
Set WbkColle = Nothing

End Sub

Discussions similaires

Comment faire le symbole coeur vide/coeur blanc

Dessiner avec son clavier et avec des lettres

le frigo ne marche pas....

Statut « en ligne » alors que non

Comment faire le signe de croix (chrétiens) ?

Discussions similaires

Newsletters