[XL-2000] Copie de données d'un classeur à un autre

[juju05]

[Resolu] [XL-2000] Copie de données d'un classeur à un autre

Je souhaite copier les tableaux des différentes feuilles du classeur "Matrice Louise boost.xls" (sauf la feuille Fctnmt) dans le classeur "Intégration heures boost.xls" à la suite de ce qu'il y a déjà.

Sur un autre forum, on m'a donné une instruction mais cela ne fonctionne pas.

Je souhaite également ne coller que les valeurs, pas la mise en forme ni les formules.

D'autre part, je souhaite connaitre l'instruction qui permette de connaître le numéro de ligne de la dernière ligne d'un tableau (la colonne 1 est toujours renseignée).

Merci d'avance.

 

[jp14]

Re : [XL-2000] Copie de données d'un classeur à un autre

Bonjour

Ci dessous une procédure pour recopier les valeurs.

Option Explicit
Dim Fichier As Variant
Dim nomfichier As String
Dim wbo1 As Workbook
Dim wso1 As Worksheet, wso2 As Worksheet
Sub copiedonnées()
Dim Sh As Worksheet
Dim plage1 As Range
Dim plage2 As Range
Dim dl1 As Long ' dernière ligne
Dim dld As Long ' dernière ligne
Dim wbsd As Worksheet
'Set wbsd = Workbooks(ActiveWorkbook.Name & ".xls").Sheets(ActiveSheet.Name)
Set wbsd = Workbooks(ActiveWorkbook.Name).Sheets(ActiveSheet.Name)
ouvrirfichier1

Application.ScreenUpdating = False 'gele l'ecran
Application.DisplayAlerts = False 'interdit les messages d'avertissements

For Each Sh In wbo1.Worksheets
    
        If Sh.Name <> "Fctnmt" Then
        
            Set wso1 = wbo1.Sheets(Sh.Name)
            dld = wbsd.Cells(wbsd.Rows.Count, 2).End(xlUp).Row + 2
            wbsd.Range("b" & dld) = " Feuille " & Sh.Name
            dld = wbsd.Cells(wbsd.Rows.Count, 2).End(xlUp).Row + 1
            
            With wso1
                dl1 = .Cells(.Rows.Count, 2).End(xlUp).Row
                    Set plage1 = wso1.Range("a2:d" & dl1)
                    plage1.Copy
                    wbsd.Range("a" & dld).PasteSpecial Paste:=xlPasteValues
            End With
        End If
    
Next Sh
wbo1.Close
Application.ScreenUpdating = True 'gele l'ecran
Application.DisplayAlerts = True 'interdit les messages d'avertissements

End Sub
Private Sub ouvrirfichier1()
Dim i As Integer
Dim Sh As Worksheet
Dim classeur As Workbook
Dim tablo() As String
'La variable est de type Variant car elle peut prendre les valeurs:
        'Booleenne: (Vrai/Faux) quand l'utilisateur ne sélectionne rien, ou annule l'opération.
        'String: pour renvoyer le nom du fichier sélectionné.
    'Affiche la boîte de dialogue "Ouvrir"
        Fichier = Application.GetOpenFilename("Tous les fichiers (*.xls),*.xls")
        'On sort si aucun fichier n'a été sélectionné ou si l'utilisateur
        'a cliqué sur le bouton "Annuler", ou sur la croix de fermeture.
        If Fichier = False Then Exit Sub
    'Workbooks.Open Filename:=Fichier
    tablo = Split(Fichier, "\")
    
    'Affiche le chemin et le nom du fichier sélectionné.
    Set classeur = GetObject(Fichier)

    'Set classeur = GetObject(Fichier)
    Set wbo1 = Workbooks(tablo(UBound(tablo))) '
End Sub

Ci dessous le code pour trouver la dernière ligne ( version 2007)

dld = wbsd.Cells(wbsd.Rows.Count, x).End(xlUp).Row

x numéro de la colonne
wbsd = sheets(nom de la feuille)

JP

 

[juju05]

Re : [XL-2000] Copie de données d'un classeur à un autre

Ce code marche à merveille. Cependant, si mon tableau source devait avoir une colonne supplémentaire, je devrai modifier ma macro.
N'y a t-il pas un moyen pour prendre tout le tableau en se positionnant sur la cellule A2 ?

J'ai essayé de modifié le script proposé mais cela ne fonctionne pas. J'ai un message objet requis sur le set plage ...

With wso1
                dl1 = .Cells(.Rows.Count, 2).End(xlUp).Row
                    ' Set plage1 = wso1.Range("a2:d" & dl1)
                    Range("A2").Select
                    Set plage1 = wso1.Range(Selection, ActiveCell.SpecialCells   (xlLastCell)).Select
                    plage1.Copy
                    wbsd.Range("a" & dld).PasteSpecial Paste:=xlPasteValues
            End With

 

[jp14]

Re : [XL-2000] Copie de données d'un classeur à un autre

Bonsoir

Code à intégrer dans la procédure

[COLOR="Red"]Dim dcel As String[/COLOR]
.........................
[COLOR="Red"]dcel = wso1.Cells.SpecialCells(xlCellTypeLastCell).Address(0, 0)[/COLOR]
Set plage1 = wso1.Range("a2:" & [COLOR="Red"]dcel[/COLOR])

JP