Copier coler valeur d'un classeur à un autre

Résolu
rubpon -  
lermite222 Messages postés 9042 Statut Contributeur -
Bonjour,

D'abord merci énormement pour vos aides aux personnes ayant ds le besoin. Je suis un débutant en vba et je me permets de vous soumettre mon problème.

J'aimerais copier la feuille1 nommée(Maquette) de mon classeur (lotcft) dans un deuxieme classeur(deb).

Voici ma programmation:

Private Sub CommandButton1_Click()

PWD = "cvs"
Var_Chemin = "C:\Users\jean\Desktop\luc\deb"
lotcft = ActiveWorkbook.Name
Workbooks.Open Var_Chemin, 0, ReadOnly:=False
deb = ActiveWorkbook.Name
Workbooks(lotcft).Sheets("maquette").Copy Before:=Workbooks(deb).Sheets(1)
ActiveSheet.Select
pole = ActiveSheet.Range("AA3").Value
On Error Resume Next
ActiveSheet.Name = pole
ActiveSheet.Unprotect PWD
End Sub

Cela marche correctement.

Mais au fait, la feuille1 contient bcq de formule et mon souhait, c'est de copier uniquement les valeurs de la feuille1 dans le classeur2.

Pouvez vous m'aider SVP ?

Merci d'avance.
Configuration: Windows XP
Internet Explorer 6.0

13 réponses

Résumé de la discussion

Copier une feuille nommée Maquette d'un classeur vers un autre tout en ne conservant que les valeurs et non les formules présente un enjeu pratique majeur pour éviter les répercussions de calcul. La solution clé consiste à coller les données dans le classeur de destination en valeurs uniquement, sans transférer les formules ni les formats, afin de préserver des résultats statiques. Des échanges ont aussi porté sur l'ouverture automatique du fichier mensuel et sur la détermination de la feuille cible, avec des options pour automatiser le chemin et le nom du classeur. Une nuance utile est d’utiliser UsedRange pour limiter la zone copiée et de viser une cellule de départ précise dans la destination, afin d’éviter d’écraser des données déjà présentes.

Bobot (l'IA à votre service)
  1. Utilisateur anonyme
     
    Bonjour,

    Il y a un truc j'en suis sur mais malheureusement je ne le connais pas
    et c'est ce que j'aime de VBA tout ce qui ne se voit pas peut se construire.
    Alors voici comment je procède dans cette situation, à adapter bien sur.

    <code>
    Sub CopierX1X2()

    Dim Plage As Range, Cellule As Range
    Dim varChemin As String, PWD As String, Pole As String
    Dim varAdresse As String, varValeur As Variant

    varChemin = "C:\Users\jean\Desktop\luc\deb.xls"
    lotcft = ActiveWorkbook.Name
    Pole = ActiveSheet.Range("AA3").Value
    Workbooks.Open Var_Chemin, 0, ReadOnly:=False
    deb = ActiveWorkbook.Name
    Sheets(1).Select
    Sheets.Add
    On Error Resume Next
    ActiveSheet.Name = Pole

    Workbooks(lotcft).Activate
    Set Plage = ActiveSheet.UsedRange

    For Each Cellule In Plage
    varAdresse = ""
    varValeur = ""
    If (Mid(Cellule.Value, 1, 1) <> "=") Then
    varAdresse = Cellule.Address
    varValeur = Cellule.Value
    If (varValeur <> "") Then
    Workbooks(deb).Activate
    ActiveSheet.Range(varAdresse).Value = varValeur
    Workbooks(lotcft).Activate
    End If
    End If
    Next Cellule

    Workbooks(deb).Activate
    ActiveSheet.Unprotect PWD

    End Sub
    '

    Lupin
    0
    1. rubpon
       
      Merci pr votre réponse. Mais cela ne fonctionne pas. Avez vous autre chose à me proposer?
      0
  2. Utilisateur anonyme
     
    re:

    alors voici une version que j'ai testé : 

    Sub CopierX1X2()

    Dim varCheminS As String, varCheminD As String
    Dim PWD As String, Pole As String
    Dim deb As String, lotcft As String
    Dim varAdresse As String, varValeur As Variant
    Dim Plage As Range, Cellule As Range
    
    Application.ScreenUpdating = False
    varCheminS = "D:\Documents and Settings\Hudson Hawks\Mes documents\source.xls"
    Workbooks.Open varCheminS, 0, ReadOnly:=False
    lotcft = ActiveWorkbook.Name
    Pole = ActiveSheet.Range("AA3").Value
    varCheminD = "D:\Documents and Settings\Hudson Hawks\Mes documents\destination.xls"
    Workbooks.Open varCheminD, 0, ReadOnly:=False
    deb = ActiveWorkbook.Name
    Sheets(1).Select
    Sheets.Add
    On Error Resume Next
    ActiveSheet.Name = Pole
    
    Workbooks(lotcft).Activate
    Set Plage = ActiveSheet.UsedRange
        
    For Each Cellule In Plage
        varAdresse = ""
        varValeur = ""
        If (Mid(Cellule.Value, 1, 1) <> "=") Then
            varAdresse = Cellule.Address
            varValeur = Cellule.Value
            If (varValeur <> "") Then
                Workbooks(deb).Activate
                ActiveSheet.Range(varAdresse).Value = varValeur
                Workbooks(lotcft).Activate
            End If
        End If
    Next Cellule
    
    Workbooks(deb).Activate
    ActiveSheet.Unprotect PWD
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Workbooks(lotcft).Activate
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub
'


    Lupin
    0
  3. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Pour copier uniquement les valeur et non les formules... 
    Sub CopieDansAutreClasseur()
Dim VarChemin As String, NomOrigine As String
Dim NomCopie As String, CheminCopie As String
Dim W1 As Workbook
    Set W1 = ActiveWorkbook
    CheminCopie = "C:\Users\jean\Desktop\luc\"
    NomCopie = "deb.xls"
    Workbooks.Open CheminCopie & NomCopie
    Sheets(1).Select
    Sheets.Add
    Range("A1").Select
    W1.Sheets("maquette").UsedRange.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Set W1 = Nothing
End Sub

    Tu dit...
    A+
    0
    1. rubpon
       
      oh! génial, ça marche tres bien. j'ai juste supprimé les Range. Merci beaucoup pr votre aide.

      Mais, Je profite pr vous poser 2 questions : - J'expere ne pas abuser de votre temps -

      Q1

      Est il possible de supprimer automatiquement certraines colonnes dans le fichier du 2ieme classeur(deb)?
      par exemple ds le classeur "deb" ; je souhaite supprimer la colonne B et J (Attention : ces colonnes contiennent des formules ds le fichier source.)

      voici mon code :
      Selection.EntireColumn.Delete
      Columns(2).Delete
      Selection.EntireColumn.Delete
      Columns(10).Delete
      Je les ai placé tout en bas des codes que vous m'avez donné. Mais ça supprime les colonnes du fichier sources "maquette"

      Avez vs une solution?

      Q2

      Mon classeur destination " deb " est en effet créer tous les mois.
      Quel code puis-je ajouter aux autres afin que le fichier copié soit colé au classeur "deb" du denier mois?


      Merci pour votre aide.
      0
    2. lermite222 Messages postés 9042 Statut Contributeur 1 199 > rubpon
       
      Re,
      ton code.. 
      Selection.EntireColumn.Delete 
Columns(2).Delete 
Selection.EntireColumn.Delete 
Columns(10).Delete

      tu met 2 fois delete ?
      il ne faut que.. 
      Columns(2).Delete 
Columns(10).Delete

      Mettre activesheet éventuellement, mais pas nécessaire puisque c'est déjà cette feuille qui est active.
      Ta Q2 j'ai pas bien compris
      A+
      0
    3. rubpon > lermite222 Messages postés 9042 Statut Contributeur
       
      Rebjr

      ma Q2 est la suivante:

      le classeur " deb " qui represente mon classeur de destination est créé ts les mois.

      Est ce qu'il y a un code qui me permet de demander:

      une copie de la feuille "maquette " du classeur1 " lotcft"
      et coler valeur ds le classer2 "deb" du dernier mois ?

      Je pense que cela va etre difficile. Mais peut etre que tu auras quelques choses à me proposer.

      Merci
      0
    4. lermite222 Messages postés 9042 Statut Contributeur 1 199 > rubpon
       
      Ca ne devrait causer aucun problème mais si tu a un classeur tout les mois soit il n'ont pas le même nom soit il ne sont pas dans le même répertoir.
      L'déal se serrait de nommer les classeurs par date comme par exemple deb0108 pour janvier 2008 et de les mettre tous dans le même répertoir.
      0
    5. rubpon > lermite222 Messages postés 9042 Statut Contributeur
       
      exactement ils sont ds le meme repertoire et st nommés par mois .

      Par exple deb0108 ---- pr janvier
      deb1008 --------pr octobre

      Le code j'avais retenu étais la suivante :
      chemincopie = "c :\ .................................\Mes documents\"
      Nomcopie = "deb.xls"

      Donc à chaque mois, serai je obligé de modifier :

      Nomcopie = "debt1008" ? et ainsi de suite

      Ou puis je ecrire autrement le code pr qu'il aille chercher directement le classeur du mois?

      merci
      0
  4. Utilisateur anonyme
     
    Bonjour,

    excellent votre approche, j'avais justement trouver une erreur
    dans mon code. Et je me suis mis a penser à la mise en forme !

    alors tant qu'a passer, je propose ceci : 

    Sub CopieDansAutreClasseur()

Dim VarChemin As String, NomOrigine As String
Dim NomCopie As String, CheminCopie As String
Dim W1 As Workbook
    
    Set W1 = ActiveWorkbook
    CheminCopie = "C:\Users\jean\Desktop\luc\"
    NomCopie = "deb.xls"
    Workbooks.Open CheminCopie & NomCopie
    Pole = ActiveSheet.Range("AA3").Value
    Workbooks(lotcft).Sheets("maquette").Copy Before:=Workbooks(deb).Sheets(1)
    ActiveSheet.Name = Pole
    Range("A1").Select
    Cells.Clear
    W1.Sheets("maquette").UsedRange.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Set W1 = Nothing

End Sub


    bien sur, notre ami ayant spécifier qu'il était débutant, j'ai introduis
    les instructions :

    Application.ScreenUpdating = False
    ...
    Application.ScreenUpdating = True

    pour l'affichage qui prend une éternité pour la macro !

    et

    Application.DisplayAlerts = False
    ...
    Application.DisplayAlerts = True

    pour désactiver les messages lors de l'enregistrement.
    à ton choix de les utiliser ou pas :-)

    Bonne continuité

    Lupin
    0
    1. rubpon
       
      Bonjour Lupin

      Merci pour tes proposition. Finalement, j'ai essayé avec celles de Lermite222 et cela marche.


      Mais, Je profite pr vous poser 2 questions : - J'expere ne pas abuser de votre temps -

      Q1

      Est il possible de supprimer automatiquement certraines colonnes dans le fichier du 2ieme classeur(deb)?
      par exemple ds le classeur "deb" ; je souhaite supprimer la colonne B et J (Attention : ces colonnes contiennent des formules ds le fichier source.)

      voici mon code :
      Selection.EntireColumn.Delete
      Columns(2).Delete
      Selection.EntireColumn.Delete
      Columns(10).Delete
      Je les ai placé tout en bas des codes que vous m'avez donné. Mais ça supprime les colonnes du fichier sources "maquette"

      Avez vs une solution?

      Q2

      Mon classeur destination " deb " est en effet créer tous les mois.
      Quel code puis-je ajouter aux autres afin que le fichier copié soit colé au classeur "deb" du denier mois?


      Merci pour votre aide.
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour Lupin,
    mais il n'est pas nécessaire de copier d'abord la feuille avec les formule pour les écraser ensuite...:-) 
    Sub CopieDansAutreClasseur()

Dim VarChemin As String, NomOrigine As String
Dim NomCopie As String, CheminCopie As String
Dim W1 As Workbook
    
    Set W1 = ActiveWorkbook
    CheminCopie = "C:\Users\jean\Desktop\luc\"
    NomCopie = "deb.xls"
    Workbooks.Open CheminCopie & NomCopie
'Cette ligne n'est pas bonne, tu prend le nom dans le classeur qui vient d'être ouvert et d'après ce que je
'comprend le nom est dans le classeur d'origine.
'Et il n'est pas nécessaire de passer par une variable qui n'est utilisée qu'une seule fois, d'ou, 2 assignations pour un seul résultat.
    'Pole = ActiveSheet.Range("AA3").Value
' ici tu copie la feuille avec les formules, pas nécessaires vu que ce serra copier plus bas. 
    'Workbooks(lotcft).Sheets("maquette").Copy   .. Before:=Workbooks(deb).Sheets(1)
'Comme dit, 2 fois l'assignation
    'ActiveSheet.Name = Pole
'Remplacer par 
    ActiveSheet.Name  = W1.ActiveSheet.Range("AA3"). 'ça j'avais oublié.
    Range("A1").Select
    'Cells.Clear ' commande inutile dans mon poste précédant puisque la feuille est vide.
    W1.Sheets("maquette").UsedRange.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Set W1 = Nothing

End Sub

    Excuse moi pour ces rectifications mais elles me semblaient nécessaires.
    Cordialement.
    0
  7. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Finalement, tu choisira la cellule toi-même, 
    Sub CopieDansAutreClasseur()
Dim VarChemin As String, NomOrigine As String
Dim NomCopie As String, CheminCopie As String, D As String
Dim W1 As Workbook
    Set W1 = ActiveWorkbook
    CheminCopie = "C:\Users\jean\Desktop\luc\"
    D = Range("A1") ' a adapter
'Tester si le nom est bien valable, pas obligatoire mais ça vaux mieux.
    If D = "" Then
        Exit Sub
        'Eventuellement mettre un message
    ElseIf Val(Left(D, 2)) < 1 Or Val(Left(D, 2)) > 12 Then
        Exit Sub
        'Eventuellement mettre un message
    ElseIf Right(D, 2) Is Not IsNumeric Then
        Exit Sub
        'Eventuellement mettre un message
    End If
    NomCopie = "deb" & D & ".xls"
    On Error GoTo PasFichier
    Workbooks.Open CheminCopie & NomCopie
    On Error GoTo 0
    Sheets(1).Select
    Sheets.Add
    Range("A1").Select
    W1.Sheets("maquette").UsedRange.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Set W1 = Nothing
Sortie:
Exit Sub
PasFichier:
    MsgBox "le fichier " & NomCopie & " est introuvable ou a été déplacer", , "Ouvrir fichier"
    Resume Sortie
End Sub


    A+
    0
    1. rubpon
       
      oh! génial. cela fonctionne correctement.

      j'ai juste modifié

      ElseIf Right(D, 2) Is Not IsNumeric Then

      par la meme chose que Left

      Je ne saurai t'exprimer ma gratitude.

      Merci beaucoup
      .
      0
    2. rubpon
       
      Slalut Lermite222

      Je me permets de te poser directement cette question pr la suite de mon fichieret s' il est possible de faire ceci:

      j'aimerais :

      dès que le fichier est copié dans mon nouveau classeur "deb"

      que ce classeur me calcule automatique:
      les sous-totaux par réference de pièce.

      Voici le code que j'ai écris.

      Range("A6:X372").Select
      Selection.Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(1, 3, 11) _
      , Replace:=True, PageBreaks:=False, SummaryBelowData:=True
      ActiveWindow.SmallScroll Down:=-348

      Je l'ai copié à la suite des codes de tu m'a donné. Mais malheureusement cela ne fonctionne pas.

      As tu une idée?

      Mereci pr ton aide
      0
  8. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Re,
    SubTotal n'est pas une fonction de VBA mais d'excel
    1°) tu sélectionne ,Subtotal tape F1 et tu trouverras la première
    2°) C'est de faire une macro qui fait ça. (le mieux à mon avis)
    A+
    0
    1. rubpon
       
      merci de m'avoir repondu.

      Mais, si je devrais faire une macro,
      as tu une idée du code à écrire?

      Merci
      0
  9. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Beh une idée,oui... c'est pas de problème pour réaliser ça mais sans ton classeur ça va être difficile.
    Peut-tu mettre ton classeur sur Cjoint.com
    et si oui, mettre le lien dans un poste suivant.
    0
    1. rubpon
       
      oui je peux le mettre en ligne.

      je te tiendrai au courant.

      merci
      0
    2. rubpon
       
      voici le lien

      http://cjoint.com/data/lksMTu2Yem.htm

      Merci
      0
  10. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bon, j'ai la feuille, je suppose que tes sous-totaux sont sur la colonne MONTANT, c'est la seule qui est numérique.
    Mais sur quoi doit-ont calculer les sous-totaux ?Ca je vois pas.
    0
    1. rubpon
       
      Sur colonne J c'est à dire Refdouane.

      Donc voici le calcule:

      à chaque changement de Refdouane; calculer le


      colonne A : nombre de vehicule
      Colonne C : montant
      Colonne K : le poids


      Aussi est il possible de mettre le code à la suite des autres pourqu'un seul bouton actionne tout le process?

      Merci
      0
  11. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Tu ajoute le code ci-dessous dans un module générale
    Il ne faut pas de bouton...à la fin de la macro de copie feuille tu ajoute pour avoir... 
    ......
    Range("A1").Select
    Set W1 = Nothing
    SousTotaux
End Sub

    Et le code... 
    Sub SousTotaux()
Dim ST(1 To 3) As Double
Dim Tot(1 To 3) As Double
Dim i As Integer, e As Integer
Dim A
Dim Comp As String
    A = Array(0, 1, 3, 11)
    With Sheets("SubTot") 'adapter au nom de la feuille
        Comp = Cells(2, 10)
        For i = 2 To Range("J65536").End(xlUp).Row + 1
            If Comp = Cells(i, 10) Then
                For e = 1 To 3: ST(e) = ST(e) + Cells(i, A(e)): Next e
            Else
                For e = 1 To 3
                    Cells(i - 1, e + 24) = ST(e)
                    Tot(e) = Tot(e) + ST(e): ST(e) = Cells(i, A(e))
                Next e
                Comp = Cells(i, 10)
            End If
        Next i
        For e = 1 To 3
            Cells(i, e + 24) = Tot(e):
        Next e
    End With
End Sub

    J'ai mis les sous-totaux dans les colonnes Y,Z et AA
    et je sais pas si nécessaire mais j'ai ajouté le montant total.

    A+
    PS: j'ai employé des petit tableaux et un Array, comme celà tu va pouvoir te familiariser avec et de plus c'est comme ça que c'est le plus court.

    0
    1. rubpon
       
      Bjr, comment vas tu?

      Merci pr le code.

      Voici ce lien:
      https://www.cjoint.com/?lll0hXmCFE

      Ce fichier correspond exactement à celui obtenu lorsque je lance ma macro copie/valeur.

      Et je viens de rajouter le code des sous-totaux à la suite du premier et je pensais obtenir directement le resultat final, mais cela ne fonctionne pas.

      Au fait, j'ai oublié ds le 1er fichier mis en ligne une colonne. Donc ce fichier n'étais pas le bon.

      Alors la Refdouane se situe au colonne K et non plus en J

      J'ai essayé de modifier le code en fonction du nouveau fichier, mais le resultat n'est pas concluant.
      voici le code que j'ai mis

      Dim ST(1 To 3) As Double
      Dim Tot(1 To 3) As Double
      Dim i As Integer, e As Integer
      Dim A
      Dim Comp As String
      A = Array(0, 1, 3, 11)
      With Sheets("deb")
      Comp = Cells(2, 11)
      For i = 2 To Range("k65536").End(xlUp).Row + 1
      If Comp = Cells(i, 11) Then
      For e = 1 To 3: ST(e) = ST(e) + Cells(i, A(e)): Next e
      Else
      For e = 1 To 3
      Cells(i - 1, e + 25) = ST(e)
      Tot(e) = Tot(e) + ST(e): ST(e) = Cells(i, A(e))
      Next e
      Comp = Cells(i, 11)
      End If
      Next i
      For e = 1 To 3
      Cells(i, e + 25) = Tot(e):
      Next e
      End With

      De plus, ce qui est étonnant, c'est le fait que ce code agit sur le fichier source "maquette" au lieu du ficher "deb". Et bien sûr, je l'ai mis juste avant

      Range("A1").Select
      Set W1 = Nothing
      du code copier/coler


      Qu'est ce que tu pense du code par rapport au nouveau fichier mis en ligne?

      Merci
      0
  12. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Tu remplace les chiffres 10 par 11 et les chiffres 11 par 12
    et les chiffres 24 par 25
    et tu met pas le bon nom de feuille, pour faciliter, remplace 
        With Sheets("deb")

    par 
        With ActiveSheet


    C'est de toute façon celle là qui est active.
    A+
    0
    1. rubpon
       
      Je les ai remplacé et j'ai :

      - Erreur 13 - compilation . Cette erreur se situe sur la ligne ST(e) = Cells(i, A(e))
      - et malgé que j'ai mis Activesheet, le code agit tjrs sur le fichier source. Je pense qu'on doit ajouter un code close ds le fichier source afin d'avoir un seul fichier ouvert.

      T'en pense quoi sur ces deux prob?

      As tu une autre idée pourque la code agit uniquement sur le nouveau fichier?

      Merci
      0
      1. lermite222 Messages postés 9042 Statut Contributeur 1 199 > rubpon
         
        Je ne sais rien faire avec le fichier que tu met, c'est juste une copie de ta base, y faudrait l'avoir au complet pour pouvoir tester. (avec les macros)
        0
      2. rubpon > lermite222 Messages postés 9042 Statut Contributeur
         
        le 2ieme fichier mis en ligne est le reflet en valeur de mon fichier de base.
        Au fait, le fichier de base contient beaucoup de formule qui font appel à plusieurs sources de donnée.

        Voilà pourkoi, je t'ai demandé une macro qui me permet de copier uniquement les valeurs de mon fichier de base et de l'envoyer directement ds un autre classeur .Cette partie est faite.

        Et pour la suite du traitement, je souhaitais que le fichier envoyé au classeur2 me fasse autom les sous-totaux.

        En résumé,

        A) tu prends mon fichier en ligne et tu le considère comme fiechier de base.

        ce code te permet de copier valeur et de l'envoyer au 2ieme classeur :

        Dim VarChemin As String, NomOrigine As String
        Dim NomCopie As String, CheminCopie As String, D As String
        Dim W1 As Workbook
        Set W1 = ActiveWorkbook
        CheminCopie = "C:\Documents and Settings\jea \Mes documents\2008\"
        D = Range("AB3") '

        If D = "" Then
        Exit Sub

        ElseIf Val(Left(D, 2)) < 1 Or Val(Left(D, 2)) > 12 Then
        Exit Sub
        ElseIf Val(Right(D, 2)) < 1 Or Val(Right(D, 2)) > 12 Then
        Exit Sub

        End If
        NomCopie = "deb" & D & ".xls"
        On Error GoTo PasFichier
        Workbooks.Open CheminCopie & NomCopie
        On Error GoTo 0
        Sheets(1).Select
        Sheets.Add
        ActiveSheet.Name = W1.ActiveSheet.Range("AA3")
        W1.Sheets("maquette").UsedRange.Copy
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Application.CutCopyMode = False

        B) La suite est que le fichier envoyé au classeur2 me calcule automatiq les sous-totaux. D'où la dernière macro que tu m'a donné.


        Est ce que mon explication est claire?
        0
  13. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    oui, essaye avec... 
    With Workbooks(NomCopie ).sheet(1)

    Je teste pas sinon je doit chaque fois créer 2 classeur.
    Tu dit...
    0
    1. rubpon
       
      Nom ça ne marche pas.

      Par contre avec ActiveSheet , voila comment cela fonctionne i:

      a)- 1ere exécution macro j'ai :
      erreur d'exécution "13" incompatibilité de type sur la ligne ST(e) = Cells(i, A(e))
      et je clique sur Debogage.
      J'ai les sous totaux sur le fichier de base. Mais le nouveau classeur s'ouvre sans calcule des ss totaux

      b) - Je ferme le nouveau classeur sans sauvegarde et je relance une 2ieme fois la macro et j'ai tjrs :

      erreur d'exécution "13" incompatibilité de type sur la ligne ST(e) = Cells(i, A(e))
      je clique sur Debogage.

      Et j'ai maintement les sous-totaux sur le nouveau classeur et aussi sur le fichier de base.


      Je pense qu'on a déjà fait le grand chemin.

      As tu une idée

      Merci
      0
  14. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    J'avais pas compté que le nombre de lignes pouvait être Plus/moins, ce qui rend la formulr VBA non valide pour la fin des lignes.
    Remplacer par... 
    Sub SousTotaux()
Dim ST(1 To 3) As Double
Dim Tot(1 To 3) As Double
Dim i As Integer, e As Integer
Dim A
Dim Comp As String
    A = Array(0, 1, 3, 12)
    With Sheets("deb") 'adapter au nom de la feuille
        Comp = Cells(2, 11)
        i = 2
        While Cells(i, 11) <> ""
            If Comp = Cells(i, 11) Then
                For e = 1 To 3: ST(e) = ST(e) + Cells(i, A(e)): Next e
            Else
                For e = 1 To 3
                    Cells(i - 1, e + 25) = ST(e)
                    Tot(e) = Tot(e) + ST(e): ST(e) = Val(Cells(i, A(e)))
                Next e
                Comp = Cells(i, 11)
            End If
            i = i + 1
            DoEvents
        Wend
        For e = 1 To 3
            Cells(i + 1, e + 25) = Tot(e):
        Next e
    End With
End Sub

    J'ai tester et ça fonctionne.
    A+

    0
    1. rubpon
       
      Merci.

      Cela fonctionne et j'ai plus l'erreur d'exécution 13.

      Mais je ne comprends pas pourquoi je dois exécuter 2 fois la macro avant d'avoir les sous - totaux ds mon classeur2
      De plus, la 1ere fois, je dois refermer le classeur2 sans sauvegarder
      Et la 2ieme fois, j'ai le resultat recherché.

      c'est mystere.

      Merci bcq.
      0
      1. lermite222 Messages postés 9042 Statut Contributeur 1 199 > rubpon
         
        Ti a bien mis les routines dans un module générale ? Genre Module1 ?
        A+
        0

Discussions similaires

Copier une feuille d'un classeur qui s'actualise
André Roussel -
LaBoule2Petanque -

4 réponses