Copier coler valeur d'un classeur à un autre
Résolu/Fermé
rubpon
-
8 nov. 2008 à 12:45
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 - 13 nov. 2008 à 07:20
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 - 13 nov. 2008 à 07:20
A voir également:
- Copier coler valeur d'un classeur à un autre
- Copier une vidéo youtube - Guide
- Copier un disque dur - Guide
- Super copier - Télécharger - Gestion de fichiers
- Copier texte pdf - Guide
- Logiciel gratuit calcul valeur nutritionnelle - Télécharger - Santé & Bien-être
13 réponses
Utilisateur anonyme
8 nov. 2008 à 15:23
8 nov. 2008 à 15:23
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
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
Utilisateur anonyme
8 nov. 2008 à 22:34
8 nov. 2008 à 22:34
re:
alors voici une version que j'ai testé :
Lupin
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
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
8 nov. 2008 à 23:46
8 nov. 2008 à 23:46
Bonjour,
Pour copier uniquement les valeur et non les formules...
Tu dit...
A+
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+
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.
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.
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
>
rubpon
9 nov. 2008 à 13:58
9 nov. 2008 à 13:58
Re,
ton code..
tu met 2 fois delete ?
il ne faut que..
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+
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+
rubpon
>
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
9 nov. 2008 à 15:12
9 nov. 2008 à 15:12
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
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
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
>
rubpon
9 nov. 2008 à 15:17
9 nov. 2008 à 15:17
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.
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.
rubpon
>
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
9 nov. 2008 à 15:49
9 nov. 2008 à 15:49
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
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
Utilisateur anonyme
9 nov. 2008 à 13:29
9 nov. 2008 à 13:29
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 :
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
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
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.
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.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
9 nov. 2008 à 13:49
9 nov. 2008 à 13:49
Bonjour Lupin,
mais il n'est pas nécessaire de copier d'abord la feuille avec les formule pour les écraser ensuite...:-)
Excuse moi pour ces rectifications mais elles me semblaient nécessaires.
Cordialement.
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.
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
9 nov. 2008 à 17:37
9 nov. 2008 à 17:37
Finalement, tu choisira la cellule toi-même,
A+
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+
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
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
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
10 nov. 2008 à 17:27
10 nov. 2008 à 17:27
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+
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+
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
10 nov. 2008 à 18:22
10 nov. 2008 à 18:22
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.
Peut-tu mettre ton classeur sur Cjoint.com
et si oui, mettre le lien dans un poste suivant.
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
10 nov. 2008 à 18:54
10 nov. 2008 à 18:54
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.
Mais sur quoi doit-ont calculer les sous-totaux ?Ca je vois pas.
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
11 nov. 2008 à 00:33
11 nov. 2008 à 00:33
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...
Et le code...
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.
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.
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
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
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
11 nov. 2008 à 13:05
11 nov. 2008 à 13:05
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
par
C'est de toute façon celle là qui est active.
A+
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+
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
- 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
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
>
rubpon
11 nov. 2008 à 14:16
11 nov. 2008 à 14:16
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)
rubpon
>
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
11 nov. 2008 à 15:02
11 nov. 2008 à 15:02
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?
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?
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
11 nov. 2008 à 15:14
11 nov. 2008 à 15:14
oui, essaye avec...
Je teste pas sinon je doit chaque fois créer 2 classeur.
Tu dit...
With Workbooks(NomCopie ).sheet(1)
Je teste pas sinon je doit chaque fois créer 2 classeur.
Tu dit...
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
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
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
11 nov. 2008 à 16:36
11 nov. 2008 à 16:36
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...
J'ai tester et ça fonctionne.
A+
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+
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.
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.
lermite222
Messages postés
8724
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 190
>
rubpon
13 nov. 2008 à 07:20
13 nov. 2008 à 07:20
Ti a bien mis les routines dans un module générale ? Genre Module1 ?
A+
A+
8 nov. 2008 à 19:38