Copie de cellules dans une autre classeur

Bonjour a tous,

Voila je voudrai copier des valeurs du classeur nommer par exemple CARTOUCHE 10011-07 (chaque classeurs a un autre nom) vers une autre feuille d'un autre classeur.

Il me faut copier que les cellules des lignes 38, 87, 137. jusque que la mon code fonctionne pas trop mal (voir fichier joint)

Ce que je voudrais c'est que les valeurs copier soit coller l'une en dessous des autres toute dans la colone "A".par exemple.

Quelqu'un de vous pourrai t'il m'aider a résoudre mon problème?

D'avance un grand Merci

Didier

Hello,

Sniff, personne ne peu apparament m'aider, pourtant je suis sur que ca ne dois pas être impossible.

Je vous remercie d'avance de votre aide

Amicalement

Didier

Bonsoir,

Si j'ai bien compris,

remplace

Range("A1").Select par : Range("A65536").End(xlUp)(2).Select

    Set ClasseurDestination = ActiveWorkbook
    ClasseurSource.Activate
    Range("B38:BB38,B87:BB87,B137:BB137").Copy
    ClasseurDestination.Activate
    Sheets("Feuil1").Select
    Range("A65536").End(xlUp)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Set ClasseurSource = Nothing
    Set ClasseurDestination = Nothing
End Sub

Amicalement

Claude

Hello,

Oui et non, mais ca ma donner un bon départ de piste, voici le code que j'ai "bricoller" oui je pense que ca ne dois pas être très catholique mais bon ca fonctionne.

J'ai juste un petit soucis de mise en page, y a t'il moyen de forcer la mise en page pour que toute les cellules coller soit aligner à gauche?

Claude je te remercie pour ton aide.

Sub copie_sur_liste()
    Dim NomFichier As String
    Dim NomClasseur As String
    Dim ClasseurSource As Workbook
    Dim ClasseurDestination As Workbook

    Set ClasseurSource = ActiveWorkbook

    NomFichier = Application.GetOpenFilename
    If NomFichier = "Faux" Then
        Exit Sub
    Else
        NomClasseur = IsoleNom(NomFichier)

        If TesteSiOuvert(NomClasseur) Then
            Workbooks(NomClasseur).Activate
        Else
            Workbooks.Open NomFichier
        End If
    End If

    Set ClasseurDestination = ActiveWorkbook

    ClasseurSource.Activate
    Range("B38:BB38,B85:BB85,B137:BB137").Select    'copie les cellules
    Selection.Copy

    ClasseurDestination.Activate                    'ouvre l'explorateur pour choisir un fichier
    Sheets("Bulletin_livraison_plan").Select
    Range("A9").End(xlUp)(2).Select                 'A modifier emplacement

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

    Range("B9:B50").Copy Range("A65536").End(xlUp).Offset(1, 0) 'recherche première cellules vide dans A et colle les valeurs de b
    Range("B9:B50").ClearContents                               'efface les valeurs de B

    Range("C9:C50").Copy Range("A65536").End(xlUp).Offset(1, 0)
    Range("C9:C50").ClearContents

    Set ClasseurSource = Nothing
    Set ClasseurDestination = Nothing
End Sub

Bonsoir,

Juste pour le fun....

J'ai un peu modifié tes fonctions personnalisées "IsoleNom" et "TesteSiOuvert"...

Sub copie_sur_liste()
'......
NomFichier = Application.GetOpenFilename
    If NomFichier = "Faux" Then
        Exit Sub
    Else
        NomClasseur = IsoleNom(NomFichier)

        If TesteSiOuvert(NomClasseur) Then
            Workbooks(NomClasseur).Activate
        Else
            Workbooks.Open NomFichier
        End If
    End If
'......
End Sub

Public Function IsoleNom(NomFichier) As String
    IsoleNom = Dir(NomFichier)
End Function

Public Function TesteSiOuvert(NomDuClasseur As String) As Boolean
    On Error Resume Next
    TesteSiOuvert = Len(Workbooks(NomDuClasseur).Name)
End Function

Bonne soirée

Bonjour,

On travaille à l'aveuglette !

de plus, c'est plus la même action qu'au départ, tu transpose la copie maintenant ?

et c'est quoi cette ligne qui va sans doute t'amener des ennuis ?

Range("A9").End(xlUp)(2).Select  

Claude

Hello,

A vous 2 et Merci d'avance de vous être arrêter sur mon problème.

Je vais expliquer ce que je recherche a faire exactement.

J'ai sur une liste excel des informations pour remplir un cartouche sur des plans (gèrer par liaison excel-autocad).

sur cette liste apparait des numeros de plans information sur les lignes B38:BB38,B85:BB85,B137:BB137. (Voir cartouche 10011-07)

Puis coller ces numeros de plans en colonne (dès la cellules A9) (Voir Bulletin)

Voila j'espère avoir été plus clair que dans mon précédant mail.

En vous remerciant d'avance

Salutations

Didier

Bonsoir,

d'après ce que j'ai compris, il faut faire l'opération en 3 fois

essaye comme ceci

Sub copie_sur_liste()
    Dim NomFichier As String
    Dim NomClasseur As String
    Dim ClasseurSource As Workbook
    Dim ClasseurDestination As Workbook

    Set ClasseurSource = ActiveWorkbook

    NomFichier = Application.GetOpenFilename
    If NomFichier = "Faux" Then
        Exit Sub
    Else
        NomClasseur = IsoleNom(NomFichier)

        If TesteSiOuvert(NomClasseur) Then
            Workbooks(NomClasseur).Activate
        Else
            Workbooks.Open NomFichier
        End If
    End If

'*****-------- modif à partir d'ici --------*****
    Set ClasseurDestination = ActiveWorkbook
    Sheets("Bulletin_livraison_plan").Activate

    ClasseurSource.Activate
    '----- (les 2 classeurs sont ouverts) -----
    With ClasseurSource
        .Range("B38:BB38").Copy
    End With
    With ClasseurDestination
        .Range("A65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    End With
    With ClasseurSource
        .Range("B85:BB85").Copy
    End With
    With ClasseurDestination
        .Range("A65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    End With
    With ClasseurSource
        .Range("B137:BB137").Copy
    End With
    With ClasseurDestination
        .Range("A65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    End With
End Sub

Claude

Hello,

Merci pour le code, mais ca ne fonctionne pas, j'ai réussi a corriger un problème c'est:

.Range("B38:BB38").Copy

(j'ai enlever le point (.) devant le Range pour les 6.

Avec ca la copie s'effectue.

Le truc c'est qu'il me fais la copie sur le classeur Cartouche 10011-07 a la dernière ligne vide, et non pas sur le classeur de destination. et je ne sais pas ou y peu y avoir l'erreur?

Merci de ton aide,

Salutation

Didier