Programmation Copier/coller

Mickicool -  
lermite222 Messages postés 9042 Statut Contributeur -
Bonjour,

Je souhaite à l'aide d'un bouton effectuer un copier coller. J'ai déja programmer pour copier et coller d'une feuille à une autre mais pour une seule ligne. Voici le programme

Sheets("Registre opérations").Select
Range(Cells(4, 1), Cells(4, 33)).Copy

Workbooks.Open Filename:= _
"\\"Noms du dossiers et fichier"
Sheets("Nom de la feuille").Select

derlig = Cells(65536, 1).End(xlUp).Row

Cells(derlig + 1, 1).Select

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

With Workbooks(2)
.Save
.Close
End With

Celà me copiant uniquement la ligne 4 de la colonne 1 à la 33.

4 réponses

  1. Heremion Messages postés 564 Statut Membre 102
     
    Bonjour Mickicool,

    Mais tu ne nous dit pas finalement ce que tu souhaites faire?
    0
    1. Mickicool
       
      Si mais tout ne s'affiches pas... Voici la suite...

      Maintenant je souhaiterais effectuer la même oération différement.
      Copier de A4 à F9 dans les lignes d'un autre fichier en A4 à F9 ET les lignes G4 à G9 dans I4 à I9; H4 à H9 dans L4 à L9; I4 à I9 dans O4 à O9; J4 à J9 dans R4 à R9; K4 à K9 dans U4 à U9

      Tout en gardant l'option de toujours mettre les informations à la suite les unes des autres...

      Cordialement7 / Internet Explorer 8.0</config>
      0
  2. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Avec un tableau ?
    Sub CopieMulti()
    Dim AD(4) As String
    Dim i As Integer
        Sheets("Registre opérations").Select
        AD(0) = Range(Cells(4, 1), Cells(4, 33)).Address
        AD(1) = Range(Cells(10, 1), Cells(10, 33)).Address
        AD(2) = Range(Cells(30, 1), Cells(30, 33)).Address
        Sheets("Nom de la feuille").Select
    
        derlig = Cells(65536, 1).End(xlUp).Row + 1
        With Sheets("Registre opérations")
            For i = 0 To 2
                .Range(AD(i)).Copy
                Cells(derlig + i, 1).PasteSpecial Paste:=xlPasteValues
            Next i
        End With
    End Sub

    Les adresses de AD sont à adapter à tes besoins
    A+
    Note: Pas tester, possible qu'il faudra séparer le PasteSpecial
    0
    1. Mickicool
       
      ok merci,

      Mais celà fontionne t-il si je l'applique à 2 boutons différents pour 2 opérations quasi identique mais avec d'autre case ?
      0
  3. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Si je comprend bien.. OUI mais tu dois mettre la déclaration du tableau en public (Dans un module.BAS)

    Public AD(4) As String

    0
  4. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Un exemple..
    Option Explicit 
    Dim AD() As String 
    Dim Ajouter As Integer 
    Private Sub Sauve_Click() 
    ReDim Preserve AD(Ajouter + 2) 
        Sheets("Registre opérations").Select 
        AD(Ajouter) = Range(Cells(4, 1), Cells(4, 33)).Address 
        AD(Ajouter + 1) = Range(Cells(10, 1), Cells(10, 33)).Address 
        AD(Ajouter + 2) = Range(Cells(30, 1), Cells(30, 33)).Address 
    
    End Sub 
    
    Private Sub Ajouter_Click() 
    ReDim AD(2) 
        Sheets("Registre opérations").Select 
        AD(0) = Range(Cells(4, 1), Cells(4, 33)).Address 
        AD(1) = Range(Cells(10, 1), Cells(10, 33)).Address 
        AD(2) = Range(Cells(30, 1), Cells(30, 33)).Address 
        Ajouter = 3 
    End Sub 
    
    Sub CopieMulti() 
    Dim i As Integer 
    
        derlig = Cells(65536, 1).End(xlUp).Row + 1 
        With Sheets("Registre opérations") 
            For i = 0 To UBound(AD) 
                .Range(AD(i)).Copy 
                Cells(derlig + i, 1).PasteSpecial Paste:=xlPasteValues 
            Next i 
        End With 
    End Sub

    Bien entendu, adresse et nombre de mémo à adapter
    Les boutons doivent êtres sur la même feuille, sinon faut modifier comme dit plus haut (Public)
    Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
    NOTE : Je ne répond pas aux MP pour les questions techniques.
    0