mettre des valeurs en mémoire

re,j'ai ce code qui fonctionne, mais quelqu'un peut-il me dire si y'a plus
simple ?
Merci.
YANN
------
Sub FeuilleExcel()
Dim VarA1 As String, VarA2 As String, VarA3 As String, VarB1 As String,
VarB2 As String, VarB3 As String, _
VarF1 As String, VarF2 As String, VarF3 As String, VarF4 As String, VarF5 As
String, _
VarG1 As String, VarG2 As String, VarG3 As String, VarG4 As String, VarG5 As
String
VarA1 = [DGA!A1].Value
VarA2 = [DGA!A2].Value
VarA3 = [DGA!A3].Value
VarB1 = [DGA!B1].Value
VarB2 = [DGA!B2].Value
VarB3 = [DGA!B3].Value
VarF1 = [DGA!F1].Value
VarF2 = [DGA!F2].Value
VarF3 = [DGA!F3].Value
VarF4 = [DGA!F4].Value
VarF5 = [DGA!F5].Value
VarG1 = [DGA!G1].Value
VarG2 = [DGA!G2].Value
VarG3 = [DGA!G3].Value
VarG4 = [DGA!G4].Value
VarG5 = [DGA!G5].Value
Dim NomDoc As String
'Set excelobj = CreateObject("Excel.Application")
NomDoc = InputBox("Entrez le nom du document Excel que vous allez créer")
Workbooks.Open Filename:="G:COLLypaDossiers de
travailModeleRevisHoche.xlt"
With Sheets("Feuil1")
.[A1] = VarA1
.[A2] = VarA2
.[A3] = VarA3
.[B1] = VarB1
.[B2] = VarB2
.[B3] = VarB3
.[H1] = VarF1
.[H2] = VarF2
.[H3] = VarF3
.[H4] = VarF4
.[H5] = VarF5
.[I1] = VarG1
.[I2] = VarG2
.[I3] = VarG3
.[I4] = VarG4
.[I5] = VarG5
End With
If NomDoc <> "" Then
ActiveWorkbook.SaveAs ThisWorkbook.path & "" & NomDoc
End If
End Sub
-------------

Bonjour,

Une piste avec le code suivant

*********
Sub FeuilleExcel()
Dim S As Worksheet
Dim i&
Dim R(1 To 2) As Range
Dim var(1 To 2)
Dim NomDoc As String
Dim source
Dim dest
source = Array("", "A1:B3", "F1:G5")
dest = Array("", "A1:B3", "H1:I5")
Set S = Sheets("DGA")
For i& = 1 To UBound(source)
Set R(i&) = Range(source(i&))
var(i&) = R(i&)
Next i&
NomDoc = InputBox("Entrez le nom du document Excel que vous allez créer")
If NomDoc = "" Then Exit Sub
Workbooks.Open Filename:= _
"G:COLLypaDossiers de travailModeleRevisHoche.xlt"
Set S = Sheets(1)
For i& = 1 To UBound(dest)
Set R(i&) = S.Range(dest(i&))
R(i&) = var(i&)
Next i&
ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & NomDoc
End Sub
*********

Cordialement.

PMO
Patrick Morange