[VBA-E] Copie de cellules

Version imprimable

18/12/2006, 09h21
max2245

merci

Merci pour votre réponse!

Je voulais savoir quelque chose?
Comment copier coller des cellules d'une feuille d'un classeur
sur une autre feuille d'un classeur, j'ai un peu de mal avec la fonction activate.
18/12/2006, 09h41
SfJ5Rpw8

Citation:

Envoyé par max2245

Merci pour votre réponse!

Je voulais savoir quelque chose?
Comment copier coller des cellules d'une feuille d'un classeur
sur une autre feuille d'un classeur, j'ai un peu de mal avec la fonction activate.

c'est normal la fonction activate elle ne sert pas à cela ... elle sert à activer une feuille, on n'as pas besoin d'activer une feuille pour effectuer une copie...

pour la copie par exemple de la feuille 2 vers feuille 1 :

Code:

Thisworkbook.sheets("Feuil1").range("A1").copy Thisworkbook.sheets("Feuil2").range("A1")

même chose si tu n'as pas besoin de copier le format de cellule :

Code:

Thisworkbook.sheets("Feuil2").range("A1") = Thisworkbook.sheets("Feuil1").range("A1")

Programme (suite)

Bonjour pourrais tu regarder un peu dans mon code:
En fait le but du pragramme est de transformer un fichier txt
en fichier xls, et a partir de ce fichier xls (lcb.xls) de copier
certaines lignes dans un autre fichier excel rapportbonds.xls

Je te remercie pour ton 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
 
 
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 15/12/2006 par Maxime Fraysse
'
 
Dim i, j, l,  row_fin As Integer
Dim Strpath As String
Dim Strg_1 As String
 
Strg_1 = "Total"
 
 
 
 
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture d'Excel
     Strpath = ThisWorkbook.Path 'Chemin d'accès du fichier
    If Right(Strpath, 1) <> "\" Then Strpath = Strpath & "\" 'Ajoute \ à la fin s'il y en a pas
    StrFich1 = "LCB.txt" 'Nom du fichier
 
    If FSO.FileExists(Strpath & StrFich1) Then 'Existence du fichier
        waExcel.Visible = False 'Rendre invisible Excel
        'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space
        waExcel.Workbooks.OpenText Strpath & StrFich1
        'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs
        Application.DisplayAlerts = False
        waExcel.Workbooks(StrFich1).SaveAs Strpath & Left(StrFich1, Len(StrFich1) - 4) & ".xls", , , , , , 2
    End If
        'Fermeture d'Excel
    waExcel.Application.Quit
 
 
 
    If FSO.FileExists(Strpath & Left(StrFich1, Len(StrFich1) - 4) & ".xls") Then 'Existence du fichier
 
 
 
 
        'ouverture des fichiers
 
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
 
        Workbooks.Open Strpath & "\" & Left(StrFich1, Len(StrFich1) - 4) & ".xls"
        Workbooks.Open Strpath & "\" & "RapportBonds.xls"
 
        Workbooks(Strpath & "\" & Left(StrFich1, Len(StrFich1) - 4) & ".xls").Worksheets(1).Activate
 
        row_fin = 1
        While Workbooks(Left(StrFich1, Len(StrFich1) - 4) & ".xls").Worksheets(1).Cells(row_fin, 1) <> Strg_1
        row_fin = row_fin + 1
        Wend
 
 
        i = 1
 
        For i = 1 To row_fin - 1
 
        Workbooks(Strpath & "\" & "RapportBonds.xls").Worksheets(2).Cells(i + 11, 2) = Workbooks(Strpath & "\" & Left(StrFich1, Len(StrFich1) - 4) & ".xls").Worksheets(1).Cells(i + 2, 1)
 
        Next i
 
     End If
 
'    StrFich2 = "IRS.txt" 'Nom du fichier
 '   If FSO.FileExists(StrPath & StrFich2) Then 'Existence du fichier
'        waExcel.Visible = False 'Rendre invisible Excel
'        'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space
'        waExcel.Workbooks.OpenText StrPath & StrFich2
'        'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs
'        waExcel.Workbooks(StrFich2).SaveAs StrPath & Left(StrFich2, Len(StrFich2) - 4) & ".xls", , , , , , 2
'     End If
 
 
 
    'Fermeture d'Excel
  '  waExcel.Application.Quit
 
'
End Sub

ce que j'ai fait

J'aimerais savoir comment lancer une macro depuis un macro?
Comme je ne sais pas j'ai recopie la macro qui transforme le fichier .txt en .xls
et apres je recupere les fichiers de mon fichier xls sur un autre fichier xls voir code ci dessous

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
 
Sub Macro2()
 
Dim i, j, row_fin As Integer
Dim Strpath As String
Dim Strg_1 As String
 
Strg_1 = "Total"
 
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture d'Excel
     Strpath = ThisWorkbook.Path 'Chemin d'accès du fichier
    If Right(Strpath, 1) <> "\" Then Strpath = Strpath & "\" 'Ajoute \ à la fin s'il y en a pas
    StrFich1 = "LCB.txt" 'Nom du fichier
 
    If FSO.FileExists(Strpath & StrFich1) Then 'Existence du fichier
        waExcel.Visible = False 'Rendre invisible Excel
        'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space
        waExcel.Workbooks.OpenText Strpath & StrFich1
        'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs
        waExcel.Workbooks(StrFich1).SaveAs Strpath & Left(StrFich1, Len(StrFich1) - 4) & ".xls", , , , , , 2
        Application.DisplayAlerts = False
    End If
        'Fermeture d'Excel
    waExcel.Application.Quit
 
 
'
' Macro2 Macro
' Macro enregistrée le 18/12/2006 par Maxime Fraysse
'
 
Set FSO = CreateObject("Scripting.FileSystemObject")
Set waExcel = CreateObject("Excel.Application") 'Ouverture d'Excel
 
 
Strpath = ThisWorkbook.Path 'Chemin d'accès du fichier
StrFich1 = "LCB.txt" 'Nom du fichier
 
 
 
If FSO.FileExists(Strpath & "\" & Left(StrFich1, Len(StrFich1) - 4) & ".xls") Then 'Existence du fichier
 
 
 
 
        'ouverture des fichiers
 
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
 
        Workbooks.Open Strpath & "\" & Left(StrFich1, Len(StrFich1) - 4) & ".xls"
   '     Workbooks.Open Strpath & "\" & "RapportBonds.xls"
 
        Workbooks(Left(StrFich1, Len(StrFich1) - 4) & ".xls").Worksheets(1).Activate
 
 
        row_fin = 1
        While Workbooks(Left(StrFich1, Len(StrFich1) - 4) & ".xls").Worksheets(1).Cells(row_fin, 1) <> Strg_1
        row_fin = row_fin + 1
        Wend
 
        i = 1
        j = 1
 
        For i = 1 To row_fin - 1
        For j = 1 To 3
 
        Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(i + 11, j + 1) = Workbooks(Left(StrFich1, Len(StrFich1) - 4) & ".xls").Worksheets(1).Cells(i + 2, j)
        Next j
 
        For j = 5 To 6
        Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(i + 11, j) = Workbooks(Left(StrFich1, Len(StrFich1) - 4) & ".xls").Worksheets(1).Cells(i + 2, j)
        Next j
 
        Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(i + 11, 8) = Workbooks(Left(StrFich1, Len(StrFich1) - 4) & ".xls").Worksheets(1).Cells(i + 2, 7)
 
        Next i
 
 
     End If
 
'    StrFich2 = "IRS.txt" 'Nom du fichier
 '   If FSO.FileExists(StrPath & StrFich2) Then 'Existence du fichier
'        waExcel.Visible = False 'Rendre invisible Excel
'        'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space
'        waExcel.Workbooks.OpenText StrPath & StrFich2
'        'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs
'        waExcel.Workbooks(StrFich2).SaveAs StrPath & Left(StrFich2, Len(StrFich2) - 4) & ".xls", , , , , , 2
'     End If
 
 
 
    'Fermeture d'Excel
  '  waExcel.Application.Quit
 
'
End Sub

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
 
 
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 15/12/2006 par Maxime Fraysse
'
 
Dim Strpath As String
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture d'Excel
     Strpath = ThisWorkbook.Path 'Chemin d'accès du fichier
    If Right(Strpath, 1) <> "\" Then Strpath = Strpath & "\" 'Ajoute \ à la fin s'il y en a pas
    StrFich1 = "LCB.txt" 'Nom du fichier
 
    If FSO.FileExists(Strpath & StrFich1) Then 'Existence du fichier
        waExcel.Visible = False 'Rendre invisible Excel
        'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space
        waExcel.Workbooks.OpenText Strpath & StrFich1
        'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs
        waExcel.Workbooks(StrFich1).SaveAs Strpath & Left(StrFich1, Len(StrFich1) - 4) & ".xls", , , , , , 2
        Application.DisplayAlerts = False
    End If
        'Fermeture d'Excel
    waExcel.Application.Quit
 
End Sub

27/12/2006, 10h09
max2245

Suite et fin

Je te remercie Bbil, je me suis remis un peu au VBA,
et la cela va mieux, j'arrive à faire des choses sympas.
Je t'envoie un petit mail si j'ai qqch interessant à te proposer.
A+
27/12/2006, 11h51
ouskel'n'or

Comme je ne sais pas où tu en es, je réponds juste à ça :

Citation:

J'aimerais savoir comment lancer une macro depuis un macro?

Code:

Call LaMacro

Call est facultatif dans ce cas là mais regarde les exemples dans l'aide, à Call, pour voir les différents cas de figures ;)
A+