[XL-2003] Copy paste Sheet entre 3 Workbooks [Résolu]

[zazarre]

Bonjour tout le monde!
Je suis à bout avec ce fichu programme et j espère que vous pourrez m aider
Je bloque sur la situation suivante. J ai à ma disposition un fichier "Maitre" qui s apelle "Admin_Document.xls" et dans lequel se trouve tout mon code VBA. Ensuite je crée un document .xls! Je veux par la suite ouvrir un document .mht existant, copier un classeur spécifique puis le coller dans le document .xls que je viens de créer. Dès que j arrive à la commande Copy, je me retrouve toujours avec la même erreur "Out of range".Runtime Error 9 Script Out of Range.

Je vous mets le code ci-dessous! Merci beaucoup pour votre aide!

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Option Explicit
 
Sub create_new_file()
 
Dim datei_name As String
Dim datei_name_1 As String
Dim datei_name_2 As String
Dim pfad_name_public
Dim sg_name As String
Dim cdir As String
Dim spath As String
Dim sg_spalte As Integer
Dim sg_zeile As Integer
Dim sg_anzahl As Integer
Dim n As Integer
Dim Source As Range
Dim Target As Range
Dim xlBook As Object 'Excel Application Object'
Set xlBook = CreateObject("Excel.Application")
Dim xlsApp1 As Object
Dim xlsBook1 As Object
Dim xlsBook2 As Object
Dim xlsSheet1 As Object
 
 
Dim Wb As Workbooks
 
 
'datei_name_1= F18 bzw. E84, F30 etc. dies aus Sheet auslesen
datei_name_2 = "_ECU_Summary_"
pfad_name_public = Range("B10")
 
'Anzahl eingetragner Steuergeraete
sg_spalte = 1
sg_zeile = 17
sg_anzahl = SgAnzahl(sg_spalte, sg_zeile)
 
 
 
 
If sg_anzahl <> 0 Then
'.MHT Datei erstellen mit erstem SG_Name
'So:
'Cells(sg_zeile, sg_spalte).Select
'sg_name = Selection.Value
'oder so:
sg_name = Cells(sg_zeile, sg_spalte).Value
 
 
xlBook.Workbooks.Add
xlBook.Worksheets(1).Name = "dummy"
xlBook.Worksheets("dummy").Range("A1") = "test"
xlBook.Application.Visible = True
Application.DisplayAlerts = False
'Workbook.ActiveWorkbook.Name
'Sheets("Sheet2").Select
'Workbooks(xlBook).Activate
 
 
datei_name_1 = Range("B5").Value 'Modell auslesen
datei_name = datei_name_1 + datei_name_2 + sg_name + ".xls"
xlBook.Worksheets(1).SaveAs Filename:= _
pfad_name_public + "\" + datei_name, FileFormat:= _
        xlWebArchive, CreateBackup:=False
 
 
 
spath = Range("B12")
cdir = (spath + "\" + datei_name_1 + datei_name_2 + sg_name + ".mht")
 
 
Workbooks.Open (cdir)
datei_name = ActiveWorkbook.Name
cdir = ActiveWorkbook.Name
Workbooks(cdir).Sheets("Sheet1").copy Before:=Workbooks(datei_name).Sheets("Sheet2")
 
End Sub
 
Function SgAnzahl(spalte As Integer, zeile As Integer)
 
Dim i As Integer
Dim spalte_ As Integer
Dim zeile_ As Integer
Dim strFirst As String
 
spalte_ = spalte
zeile_ = zeile
 
'Keine Workbook-Selected!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!1
Cells(zeile_, spalte_).Select
strFirst = Selection.Value
i = 0
While strFirst <> ""
  Cells(zeile_, spalte_).Select
  strFirst = Selection.Value
  spalte_ = spalte_ + 1
  i = i + 1
Wend
 
If i >= 1 Then SgAnzahl = i - 1
End Function

[Qwazerty]

Salut
Alors

Code :

1
2
3
4
5
6
7
8
9
 
'Ouvre le fichier
Workbooks.Open (cdir)
'Recuperation du nom de ce fichier qui vient d'etre ouvert
datei_name = ActiveWorkbook.Name
'Meme chose qu'au dessus??
cdir = ActiveWorkbook.Name
'Copy du fichier a partir du document source ... vers le document source...
Workbooks(cdir).Sheets("Sheet1").copy Before:=Workbooks(datei_name).Sheets("Sheet2")

Cdir = datei_name donc tu ne copieras jamais dans ton fichier destination

Petit truc tu peux récupérer directement ton classeur via Open

Code :

1
2
3
4
5
dim Wb as workbook
 
Wb = Workbooks.Open (cdir) 'je sais plus s'il faut le set devant la ligne
 
Wb.sheets("...").copy Before:=destination...

Par contre quoi que tu fasses, vu le message d'erreur (Out of range = dépassement de valeur dans un tableau), il me semble que tu devrais vérifier que les onglets Sheet1 dans le fichier source et Sheet2 dans le fichier de destination existent bien, car ça provoquerais effectivement un dépassement de tableau (sheets) si ces valeurs n'existaient pas.

a++
Qwaz

[zazarre]

Envoyé par Qwazerty

Salut
Alors

Code :

Qwaz

Je ne comprends pas pourquoi c'est document source vers dcoument source? Mon document source est cdir et mon document target est datei_name.
Bien vu pour le double ActiveWorkbook.Name

[Qwazerty]

Envoyé par zazarre

Je ne comprends pas pourquoi c'est document source vers dcoument source? Mon document source est cdir et mon document target est datei_name.
Bien vu pour le double ActiveWorkbook.Name

Salut
Et bien justement, c'est par ce que tu donne la même valeur a cdir et a datei_name en leur attribuant a tous deux activateworkbook.name.
Ils pointent donc tous les 2 sur le fichier actif, donc lors de la copy tu copie de cdir (fichier actif), vers datei_name...(fichier actif).

A++
Qwaz

[zazarre]

Merci beaucoup pour ton aide! Ca fonctionne parfaitement maintenant!! C'est vrai que en attribuant le meme document pour source et target c'etait difficile!
Je peux maintenant enfin continuer mon programme