copier des cellules d'une feuille d'un classeur dans une autre d'un autre classeur

Version imprimable

Bonjour tout le monde,

je travaille sur un projet en VBA et je trouve des difficultés, j'aimerais bien copier une partie d'une feuille d'un classeur quelconque (à l'utilisateur de le choisir) dans une feuille précise de mon classeur ouvert. voila mon code mais malheureusement ça ne marche pas.

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
 
Sub RechercheFichier(Chemin, Fichier)
    If Chemin <> "" Then
        '--- Se place dans le répertoire de l'application ---
 
        'Chemin renvoie le chemin d'accès complet à l'emplacement où seront enregistrés les fichiers
        Path = Chemin
 
        '
        Lect = Left(Path, 1)
        '
        ChDrive Lect
 
        ' Si la valeur envoyée indiquant la position de la 1ère occurence d'une chaine à l'intérieur d'une autre chaîne est non null
        If InStr(1, Path, "\", 1) <> 0 Then
            'Changer le répertoire courant en "Chemin"
            ChDir Path
        End If
    End If
 
    'Ouvrir la boite de dialogue standard pour lire les noms de fichiers existant (permet pas d'ouvrir le fichier)
    fileToOpen = Application.GetOpenFilename("(*.xls),*.xls")
 
    x = 0
 
    Do
        x = InStr(x + 1, fileToOpen, "\")
 
        If x = 0 Then
            Exit Do
        End If
 
        Memox = x
    Loop Until x = 0
    Chemin = Left(fileToOpen, Memox)
    Fichier = Right(fileToOpen, Len(fileToOpen) - Memox)
 
    '--- Se place dans le répertoire de l'application ---
    Path = Chemin
    Lect = Left(Path, 1)
    ChDrive Lect
    If InStr(1, Path, "\", 1) <> 0 Then
        ChDir Path
    End If
End Sub

cette fonction permet de chercher le fichier sur le quelle on va faire la copie. (ca fonctionne nikel)

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
 
 
Sub Page11()
 
    Dim Tableau1, Li1&, Co1&
    Dim Tableau2, Li2&, Co2&
    Dim Tableau3, Li3&, Co3&
 
    Application.ScreenUpdating = False
    Fichier_analyse = ActiveWorkbook.Name
 
    Windows(Fichier_analyse).Activate
    lig = 1
    Do
        x = Cells(lig, 2).Value
        y = Cells(lig + 1, 2).Value
        z = Cells(lig + 2, 2).Value
        w = Cells(lig + 3, 2).Value
        If x = "" And y = "" And z = "" And w = "" Then
            Exit Do
        End If
        lig = lig + 1
    Loop
    Range("A1:T" & lig).Select
    Tableau1 = Selection.Value
 
 
    Call RechercheFichier(Chemin, Fichier_à_Analyser)
    Workbooks.Open Filename:=Chemin & "\" & Fichier_à_Analyser, local:=True
    Windows(Fichier_à_Analyser).Activate
 
    lig = 1
    Do
        x = Cells(lig, 1).Value
        y = Cells(lig + 1, 1).Value
        z = Cells(lig + 2, 1).Value
        w = Cells(lig + 3, 1).Value
        If x = "" And y = "" And z = "" And w = "" Then
            Exit Do
        End If
        lig = lig + 1
    Loop
'la feuille "11" est la feuille sur la quele on va faire la copie
    Worksheets("11").Range("A1:T" & lig).Select
    Tableau2 = Selection.Value
    ActiveWindow.Close SaveChanges:=False
 
 
    ReDim Tableau3(UBound(Tableau1, 1), 10)
    Windows(Fichier_analyse).Activate
    k = 0
    For i = LBound(Tableau1, 1) To UBound(Tableau1, 1)
        k = k + 1
            Tableau3(k, 1) = Tableau1(i, 1)
        For j = LBound(Tableau2, 1) To UBound(Tableau2, 1)
                        'copier toute la colonne C de la feuille 11 dans la colonne E de notre feuille du classeur ouvert
                        Tableau3(k, 5) = Tableau2(j, 3)
        Next j
    Next i
 
 
    lig = 1
    For i = LBound(Tableau3, 1) + 1 To UBound(Tableau3, 1)
        Cells(lig, 5).Value = Tableau3(i, 5)
        lig = lig + 1
    Next i
 
 
    Beep
    Application.ScreenUpdating = True
 
End Sub

Merci d'avance pour vos reponse

24/09/2008, 16h12
ouskel'n'or

Citation:

voila mon code mais malheureusement ça ne marche pas.

Oui, bon, d'accord... Sur quelle ligne ? Un message d'erreur ? Lequel ? ;)
A+
24/09/2008, 16h36
ririrourou

bonjour ouskel'n'or,

justement aucune erreur le seul soucis c'est que ca change rien on dirait qu'il rentre meme pas dans la boucle for :cry::cry: la seule chose qui se fasse c'est qu'il cherche le fichier mais après rien rien nada :cry::cry:

Déjà, à quoi te sert ce code ?
Citation:
Code:

1 2 3 4 5 6 7 8 9 10 Do x = Cells(lig, 1).Value y = Cells(lig + 1, 1).Value z = Cells(lig + 2, 1).Value w = Cells(lig + 3, 1).Value If x = "" And y = "" And z = "" And w = "" Then Exit Do End If lig = lig + 1 Loop
Je n'arrive pas à le comprendre. Toutes les lignes, tu regardes si les trois lignes suivantes sont renseignées ?
Tu as une ligne vide toutes les quatre lignes ?
Qu'est censé faire l'ensemble de ton code ?
Tu dis
A+

Bonjour

But:
Pouvoir copier des données d'une feuille précise d'un classeur précis dans une autre feuille actuellement ouverte d'un autre classeure

Citation:

Envoyé par ouskel'n'or

Déjà, à quoi te sert ce code ?
Je n'arrive pas à le comprendre. Toutes les lignes, tu regardes si les trois lignes suivantes sont renseignées ?
Tu as une ligne vide toutes les quatre lignes ?

En fait il premet juste de définir si c'est la fin de feuille ou s'il y a autre chose en dessous. étant donné que j'ai des ligne vide dans mon classeur, ca me permet juste de définir la fin des données.

sinon

Citation:

Envoyé par ouskel'n'or

Qu'est censé faire l'ensemble de ton code ?

En fait, mon problème c'est que j'arrive pas à définir une feuille précise du classeur sur lequel je vais faire la copie, dans mon code:
Code:

1 2 3 4 5 'la feuille "11" est la feuille sur la quele on va faire la copie Worksheets("11").Range("A1:T" & lig).Select Tableau2 = Selection.Value ActiveWindow.Close SaveChanges:=False
je voulais selectionner toutes les données de la feuille que j'ai nomé "11" afin de pouvoir faire par la suite une copie de ce que je veut sur ma feuille actuelle
Code:

1 2 3 4 5 6 7 8 9 10 11 12 ReDim Tableau3(UBound(Tableau1, 1), 10) Windows(Fichier_analyse).Activate k = 0 For i = LBound(Tableau1, 1) To UBound(Tableau1, 1) k = k + 1 Tableau3(k, 1) = Tableau2(i, 1) For j = LBound(Tableau2, 1) To UBound(Tableau2, 1) 'copier toute la colonne C de la feuille 11 dans la colonne E de notre feuille du classeur ouvert Tableau3(k, 5) = Tableau2(j, 3) Next j Next i
Par la suite, aprés avoir enregistré les données dans un tableau 'tableau2' j'essaie de remplire mon nouveau tableau 'tableau3' qui représente une modification de mon 'tableau1'. donc tableau3 représentera les anciens données du tableau1 et puis on ajoute dans sa colonne 5 les données relatif à la colonne 3 du tableau2 celon des condition biensur, dans mon cas je compare les valeurs de la colonne 1 du tableau1 avec la 1ere colonne de tableau2 s'ils sont égales, je remplie la partie correspondante à celle figurant dans la colonne 2 du tableau2 dans la case corespondante à la colonne 5 du tableau3.
Code:

1 2 3 4 5 6 lig = 1 For i = LBound(Tableau3, 1) + 1 To UBound(Tableau3, 1) Cells(lig, 5).Value = Tableau3(i, 5) lig = lig + 1 Next i
après avoir rempli tableau3 on essaie de modifier notre feuille actuellement ouverte

Voila j'esprère que j'étais claire et encore merci pour ton attention.

25/09/2008, 14h11
ouskel'n'or

Citation:

En fait, mon problème c'est que j'arrive pas à définir une feuille précise du classeur sur lequel je vais faire la copie, dans mon code:

'la feuille "11" est la feuille sur la quele on va faire la copie

On règle déjà ça : 11 est le N° de la feuille ou son nom ?
25/09/2008, 14h31
ririrourou

son nom

Je réponds pour ça

Citation:

Envoyé par ouskel'n'or
Déjà, à quoi te sert ce code ?

En fait il permet juste de définir si c'est la fin de feuille ou s'il y a autre chose en dessous. étant donné que j'ai des ligne vide dans mon classeur, ca me permet juste de définir la fin des données.

Tu peux obtrnir le numéro de la dernière ligne renseignée de ta feuille avec diverses syntaxes, en voilà une

Code:

Lig = Split(Worksheets("11").UsedRange.address, "$")(4)

Split divise le string address en Colonnes (la lettre) et N° de ligne
Address donne un string sous cette forme "$A$1:$DerniereColonne$DerniereLigne"
Chaque $ sert de séparateur si bien qu'on peu récupérer chaque donné
et Split(..............)(4) donne le N° de la dernière ligne renseignée de ta feuille de calculs.
Il ensuite facile de supprimer toutes les lignes vides. J'ai donné une réponse hier, si elle t'intéresse je pourrai te donner l'url.
A+

Edit
Tiens, comme ce n'est pas évident, voici le code où Derlig est la dernière ligne renseignée quand toutes tes feuilles ont été copiées.
Code:

1 2 3 4 5 6 DerLig = Split(Worksheets("11").UsedRange.address, "$")(4) For i = DerLig To 1 Step -1 if Cells(1, 256).SpecialCells(xlCellTypeLastCell).Column = 1 and Cells(i, 1).Value = "" Then Rows(i).Delete End If Next i
Bon après-midi