Copy de cellules

Signaler
Messages postés
2
Date d'inscription
lundi 16 septembre 2002
Statut
Membre
Dernière intervention
17 septembre 2002
-
Messages postés
2
Date d'inscription
lundi 16 septembre 2002
Statut
Membre
Dernière intervention
17 septembre 2002
-
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 !

2 réponses

Messages postés
59
Date d'inscription
vendredi 26 juillet 2002
Statut
Membre
Dernière intervention
29 janvier 2004

'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
0
Messages postés
2
Date d'inscription
lundi 16 septembre 2002
Statut
Membre
Dernière intervention
17 septembre 2002

Merci pour les infos !
0