Discussion :

[Tho69]

Bonjour,

Le titre parle de lui même. En gras ce que je n'arrive pas à exprimer. En commentaire ce qui est à mon avis inutile.
Avec le code ci-dessous l'erreur est: Erreur d'exécution '1004' Erreur définie par l'application ou par l'objet. Je pense que le x et le y doivent être présenté à la fonction mais je ne sais pas comment.

Voici la procédure:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Application.DisplayAlerts = False
 
Const FileSource As String = "Sport"
 
Dim WkbSrce As Workbook
Dim FoldersSource As Variant
Dim SubFolder As String
Dim i As Integer
Dim x As Integer
Dim y As Integer
 
x = Target.Row
y = Target.Column 
SubFolder = ThisWorkbook.ActiveSheet.Name

'Windows("Ce fichier").Activate
'Sheets("SubFolder").Select
Cells(x, y).Select
Selection.Copy

If SubFolder Like "STR####" Then
    FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
ElseIf SubFolder Like "SCR####" Then
    FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
Else
Application.DisplayAlerts = True
    Exit Sub
End If
 
For i = 0 To UBound(FoldersSource)
    If Exporter(FoldersSource(i), SubFolder, FileSource & ".xlsx") Then
        Exit For
    End If
Next i
 
Application.DisplayAlerts = True

End Sub

Voici la fonction appelée par la procédure:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Function Exporter(ByVal Dossier As String, ByVal SousDossier As String, ByVal Fichier As String) As Boolean

Dim FichTrouve As String, SubFolder As String
Dim WkbSrce As Workbook
Dim x As Integer
Dim y As Integer

Application.ScreenUpdating = False

SubFolder = FindSubFolder(Dossier, SousDossier)

If SubFolder <> "" Then
    FichTrouve = Dir(SubFolder & "\" & Fichier)
 
    If FichTrouve <> "" Then
        Exporter = True
        Do While FichTrouve <> ""
            Set WkbSrce = Application.Workbooks.Open(SubFolder & "\" & Fichier)

            'Windows(Fichier).Activate
            'ThisWorkbook.Worksheets(1).Select
            Cells(x, y).Select
            ActiveCell.Paste
            
            Application.ScreenUpdating = True
 
            WkbSrce.Save
            WkbSrce.Close False
            Set WkbSrce = Nothing
            FichTrouve = Dir()
            
        Loop
    End If
End If

End Function

Si vous avez des suggestions... Merci.

Thomas

[parmi]

Bonjour,

Dans ta 1e macro, x devrait être dimensionné en Long puisque le nombre de lignes peut facilement dépasser les capacités d'un Integer (32768, je pense...)

De plus, comme SubFolder est une variable, tu ne devrais pas mettre de guillemets ici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

'Sheets(SubFolder).Select

Dans la 2e macro, x et y n'ont pas reçu de valeurs, donc =0
Comme il n'y a pas de ligne ou de colonne 0, ça va planter...

Voilà pour un début.

[Tho69]

Re,

Merci parmi.

Je pense que ces lignes de ma procédure sont inutile car l'évènement déclenchant cette procédure est Workbook_SheetChange:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'Windows("Ce fichier").Activate
'Sheets("SubFolder").Select

Qu'es que vous en pensez?

Et pour x et y dans la fonction tu as raison mais j'ai testé plein de choses mais je ne vois vraiment pas comment présenter ces variables à la fonction. Avez-vous une idée?

Merci.

Thomas

Bonjour,

Voici un code que j'ai expérimenté:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
ThisWorkbook.Activate
ThisWorkbook.Worksheets(SousDossier).Select
Cells(x, y).Select
Selection.Copy
 
WkbSrce.Activate
WkbSrce.Worksheets(1).Select
Cells(x, y).Select
Selection.Paste

Es que quelqu'un a une idée de pourquoi la dernière ligne de ce code déclenche l'erreur: "Erreur d'exécution '438': Propriété ou méthode non gérée par cet objet".

Merci.

Thomas

[mayekeul]

bonjour,

tu dois faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Selection.PasteSpecial xlPasteAll

;o)

sinon, on peux réduire le code à simplement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ThisWorkbook.Worksheets(SousDossier).Cells(x, y).Copy WkbSrce.Worksheets(1).Cells(x, y)

[Tho69]

Ca marche niiikel!

Merci mayekeul!

Mais pourquoi devoir faire un collage spécial?

Ta deuxième méthode fonctionne parfaitement également!

Merci beaucoup.

[mayekeul]

de rien

tu n'y est pas obligé si tu suis la méthode que je t'ai montré dans le message précédent.

Sinon suivant ton cheminement, simplement, la seule méthode qui existe pour l'objet selection est PasteSpecial.