Copy de cellules

Question

Bonsoir à tous :

Etant débutant en VB, je souhaite créer  une routine VB, qui copie une plage de cellule d'un classeur Excel dans un autre classeur, cela sans ouvrir Excel.
Malgré la consultation des codes déjà existant, j'ai du mal pour le moment à les adapter pour mes besoins.
Si qq1 peut m'aider, merci d'avance !

cs_imer · Answer

'Menu Options/Références, cocher Microsoft Excel X.X Object Library
'Dans une form avec un bouton Command1

Option Explicit

Private Type cellules
    Classeur As String
    Feuille As String
    Col1 As Variant
    ColN As Variant
    Ligne1 As Long
    LigneN As Long
End Type

Private Sub Command1_Click()

Dim cellSrc   As cellules
Dim cellDest  As cellules

With cellSrc
    .Classeur = "c:\Src.xls"
    .Feuille = "Src"
    .Col1 = "A"
    .Ligne1 = 1
    .ColN = 12
    .LigneN = 3
End With

With cellDest
    .Classeur = "c:\Dest.xls"
    .Feuille = "Cible"
    .Col1 = "A"
    .Ligne1 = 1
End With

    Call CopierCellules(cellSrc, cellDest)
    
End Sub

Private Function CopierCellules(Src_Cell As cellules, Dest_Cell As cellules)

    Dim XlApp As Excel.Application
    Dim Cell1 As Excel.Range
    Dim CellN As Excel.Range
    
    Set XlApp = New Excel.Application
    
    XlApp.Workbooks.Open Src_Cell.Classeur, , True
    XlApp.ActiveWorkbook.Worksheets(Src_Cell.Feuille).Activate

    If IsNumeric(Src_Cell.Col1) = True Then
        Set Cell1 = XlApp.ActiveSheet.Cells(Src_Cell.Ligne1, Src_Cell.Col1)
        Else
        Set Cell1 = XlApp.ActiveSheet.Range(CStr(Src_Cell.Col1) & CStr(Src_Cell.Ligne1))
    End If

    If IsNumeric(Src_Cell.ColN) = True Then
        Set CellN = XlApp.ActiveSheet.Cells(Src_Cell.LigneN, Src_Cell.ColN)
        Else
        Set CellN = XlApp.ActiveSheet.Range(CStr(Src_Cell.ColN) & CStr(Src_Cell.LigneN))
    End If

    XlApp.Workbooks(1).Worksheets(Src_Cell.Feuille).Range(Cell1, CellN).Copy
    
    If Dir(Dest_Cell.Classeur) <> "" Then
        XlApp.Workbooks.Open Dest_Cell.Classeur
        Else
        XlApp.Workbooks.Add
        XlApp.ActiveSheet.Name = Dest_Cell.Feuille
        XlApp.ActiveWorkbook.SaveAs Dest_Cell.Classeur
    End If
    
    XlApp.ActiveWorkbook.Worksheets(Dest_Cell.Feuille).Activate
    If IsNumeric(Dest_Cell.Col1) = True Then
        XlApp.ActiveSheet.Cells(Dest_Cell.Ligne1, Dest_Cell.Col1).Paste
        Else
        XlApp.ActiveSheet.Range(CStr(Dest_Cell.Col1) & CStr(Dest_Cell.Ligne1)).Select
        XlApp.ActiveSheet.Paste
    End If
    XlApp.ActiveWorkbook.Save
    
    Do Until XlApp.Workbooks.Count = 0
        XlApp.Workbooks(1).Close False
    Loop
    
    XlApp.Quit
    Set XlApp = Nothing
    
End Function

cs_tiflo · Answer

Merci pour les infos !

Copy de cellules

2 réponses

Discussions similaires