Discussion :

[hakoko]

Bonjour,
j'ai écrit un programme qui sert à copier des cellules d'un classeur Excel à un autre. Cà bug et je ne vois pas ce qu'il y a d'anormal. Quelqu'un pourrait m'aider svp.
Merci d'avance.

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
Sub extraction() 
Dim SearchString As String 
Dim SearchChar As String 
Dim MyPos As Integer 
i = 3 
NomFichierOrigine = "kkk" 
Dim Wbk1 As Workbook, Wbk2 As Workbook 
Set Wbk1 = ThisWorkbook 
Set Wbk2 = Workbooks.Open(Filename:="C:\Users\Desktop\" & NomFichierOrigine & ".xlsx")
 
Windows(NomFichierOrigine & ".xlsx").Activate 
Wbk2.Sheets(1).Select 
Wbk2.Sheets(3).Select 
 
With Selection 
 
For j = 3 To 28 
Wbk1.Worksheets(1).Cells(i, j).Value = Wbk2.Worksheets(l).Cells(i, j).Value 
Wbk1.Worksheets(3).Cells(i, j).Value = Wbk2.Worksheets(3).Cells(i, j).Value 
j = j + 1 
 
Next j 
End With 
End Sub

[Invité]

Essaie avec ce code:

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
Option Explicit
 
Public Sub Extraction()
 
    Dim i, j As Integer
    Dim NomFichierOrigine As String
    Dim Wbk1 As Workbook, Wbk2 As Workbook
 
    i = 3
    NomFichierOrigine = "kkk"
 
    Set Wbk1 = ThisWorkbook
    Set Wbk2 = Workbooks.Open(Filename:="C:\Users\Desktop\" & NomFichierOrigine & ".xlsx")
 
    For j = 3 To 28
 
        Wbk1.Worksheets(1).Cells(i, j).Value = Wbk2.Worksheets(1).Cells(i, j).Value
        Wbk1.Worksheets(3).Cells(i, j).Value = Wbk2.Worksheets(3).Cells(i, j).Value
 
    Next j
 
End Sub

Et vérifier bien que le le chemin 'C:\Users\Desktop\' est valide que le fichier 'kkk' existe et l'extension est bien en '.xlsx'.

[Philippe Tulliez]

Bonjour,
Ta ligne

Code :

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

Wbk1.Worksheets(1).Cells(i, j).Value = Wbk2.Worksheets(l).Cells(i, j).Value

Je suppose que ce n'est pas l mais 1 qu'il fallait ou alors il faut donner une valeur à la variable l
Petite remarque :
Supprime toutes les instructions avec Select, Activate, Selection elles ne servent à rien dans ton code et de plus en VBA c'est à proscrire.
Il serait bon de déclarer toutes tes variables.
L'instruction j = j + 1 ne sert à rien non plus, la valeur de J étant affectée par la boucle.
Je ne sais pas pourquoi tu utilises le bloc With Selection , il ne sert à rien non plus dans ton code.

[hakoko]

En effet, c'est le cas merci bien.
sinon j'aimerai substitué une ligne par une autre.celle ci:

Code :

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

Set Wbk2 = Workbooks.Open(Filename:="C:\Users\Desktop\" & NomFichierOrigine & ".xlsx")

je veux tout simplement definir Wbk2 = NomFichierOrigine sans avoir besoin de l'ouvrir car il est deja ouvert, s'il vous plait quelle commande je metterai?
merci bien,

[Ashireon]

Je fais actuellement la meme chose en faisant un fichier recapitulatif et cela fonctionne bien

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
41
42
43
44
Dim Fichier As String, Chemin As String
 
Dim Wb As Workbook
Dim Feuille As String
Feuille = "Gestion Prix"
Dim DerniereLigne As Integer
Chemin = "R:\MS-SERV\Maintenance\GMAO\Contrat GMAO\"
Dim nom As String
Fichier = Dir(Chemin & "*.xls")
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
 
Do While Fichier <> ""
    DerniereLigne = ThisWorkbook.Sheets("Extraction").Range("A" & Rows.Count).End(xlUp).Row + 1
    Set Wb = Workbooks.Open(Chemin & Fichier)
    nom = Wb.Name
    nom = Left(nom, Len(nom) - 4)
    Dim NContrat As String
    NContrat = Mid(nom, 1, 6)
 
    Dim X As Integer
    For X = 13 To 37
 
        If Wb.Sheets(Feuille).Range("C" & X).Value <> "" Then
            ThisWorkbook.Sheets("Extraction").Range("A" & DerniereLigne).Value = NContrat
            ThisWorkbook.Sheets("Extraction").Range("B" & DerniereLigne).Value = nom
            ThisWorkbook.Sheets("Extraction").Range("C" & DerniereLigne).Value = Wb.Sheets(Feuille).Range("C" & X).Value
            ThisWorkbook.Sheets("Extraction").Range("D" & DerniereLigne).Value = Wb.Sheets(Feuille).Range("I" & X).Value
            DerniereLigne = DerniereLigne + 1
        End If
 
    Next
 
Wb.Close
 
Set Wb = Nothing
 
Fichier = Dir
 
Loop
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
 
End Sub

[Invité]

Ça dépend comment il est ouvert mais tu peux utiliser:

Code :

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

Set Wbk2 = Workbooks(NomFichierOrigine)

[hakoko]

merci pour vos precieux conseils, ils me sont vraiments utiles.

je souhaiterai copier la ligne x de la feuil1 du classeur1 et la ligne x de la feuil 3 du meme classeur vers les lignes 2 et 4 de la feuil 1 d'un autre classeur.

j'ai essayé avec cette partie la mais ça marche pas, la macro me rempli que les données de la feuil1 du classeur1

Code :

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

1
2
3
4
5
6
For j = 3 To 28 
 
Wbk1.Worksheets(1).Cells(2, j).Value = Wbk2.Worksheets(1).Cells(3, j).Value 
Wbk1.Worksheets(1).Cells(4, j).Value = Wbk2.Worksheets(3).Cells(4, j).Value 
 
Next j