Petit problème de recopie

[Macpoy]

bonsoir le forum,
Grâce à l'excellent Thierry's j'ai bricolé une de ces macro.
elle marche très bien, mais l'inconvénient, c'est qu'elle me recopie les nombres d'une feuille d'origine dans une autre feuille mais au format texte.

dans les cellules " mal " recopier j'ai un commentaire " vert " :
"le nombre dans cette cellule est au format texte ou précédé d'une apostrophe"
au vu de la macro ci-dessous, pourriez vous me dire comment faire pour que la recopie se fasse en format nombre.

Sub Recopie() 'pour la feuille vente du classeur compta
'Thierry's Demo sur www.excel-downloads.com, December 2002
'adaptée pour mes besoins
    Dim cell As Range
    Dim MaPlage As Range
    Dim i As Integer
    Dim iF2 As Integer
    Dim ZoneA() As String, ZoneB() As String, ZoneC() As String, ZoneD() As String, ZoneE() As String
    Dim ZoneF() As String, ZoneG() As String, ZoneH() As String, ZoneI() As String, Filtre As String
    Vente.AutoFilterMode = False
Application.Dialogs(xlDialogOpen).Show
Vente.Copy Before:=ActiveWorkbook.Sheets(3)
 Filtre = InputBox("Filtrez un mois !")
 ActiveWorkbook.Sheets(3).Range("L1").Select
 
     Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:=Filtre
    
    
ActiveWorkbook.Sheets(4).Activate

 
    iF2 = 10
    
    Set MaPlage = Sheets(3).Range("A2", Range("A200").End(xlUp).Address)
    Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
    
    ReDim ZoneA(0 To MaPlage.Count - 1)
'    ReDim ZoneB(0 To MaPlage.Count - 1)
    ReDim ZoneC(0 To MaPlage.Count - 1)
    ReDim ZoneD(0 To MaPlage.Count - 1)
    ReDim ZoneE(0 To MaPlage.Count - 1)
    ReDim ZoneF(0 To MaPlage.Count - 1)
    ReDim ZoneG(0 To MaPlage.Count - 1)
    ReDim ZoneH(0 To MaPlage.Count - 1)
    ReDim ZoneI(0 To MaPlage.Count - 1)
    For Each cell In MaPlage
        ZoneA(i) = cell.Value
        ActiveWorkbook.Sheets(4).Range("A" & iF2) = ZoneA(i)
        ZoneC(i) = cell.Offset(0, 2)
        ActiveWorkbook.Sheets(4).Range("C" & iF2) = ZoneC(i)
        ZoneD(i) = cell.Offset(0, 3)
        ActiveWorkbook.Sheets(4).Range("D" & iF2) = ZoneD(i)
        ZoneE(i) = cell.Offset(0, 4)
        ActiveWorkbook.Sheets(4).Range("E" & iF2) = ZoneE(i)
        ZoneF(i) = cell.Offset(0, 5)
        ActiveWorkbook.Sheets(4).Range("F" & iF2) = ZoneF(i)
        ZoneG(i) = cell.Offset(0, 6)
        ActiveWorkbook.Sheets(4).Range("G" & iF2) = ZoneG(i)
        ZoneH(i) = cell.Offset(0, 8)
        ActiveWorkbook.Sheets(4).Range("I" & iF2) = ZoneH(i)
        ZoneI(i) = cell.Offset(0, 9)
        ActiveWorkbook.Sheets(4).Range("J" & iF2) = ZoneI(i)
        i = i + 1
        iF2 = iF2 + 1
    Next cell
 Sheets(3).Delete

End Sub

merci d'avance pour vos réponses
@plus jacques

 

[Macpoy]

Re : Petit problème de recopie

bonjour le forum,

je me permet de remonter ce post car malgré quelques essais, j'ai toujours pas trouvé.

@plus jacques

 

[job75]

Re : Petit problème de recopie

Bonjour Macpoy, le forum,

Ne pas déclarer les tableaux As String mais As Variant, donc écrire :

Dim ZoneA(), ZoneB(), ZoneC(), ZoneD(), ZoneE()
Dim ZoneF(), ZoneG(), ZoneH(), ZoneI(), Filtre As String

A+

 

[Macpoy]

Re : Petit problème de recopie

Re le forum,
bonjour job75,

merci beaucoup, c'était si simple que je "l'avais point" vu !!!

ps: à part " variant " est ce que ces déclarations peuvent prendre une autre valeur du genre " integer "

@plus jacques

 

[job75]

Re : Petit problème de recopie

Re,

Des tableaux et une boucle c'est bien lourd, voyez plutôt :

Set MaPlage = Sheets(3).Range("A2", Range("A200").End(xlUp).Address)
Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
With ActiveWorkbook.Sheets(4)
  MaPlage.Copy .Range("A10")
  Intersect(MaPlage.EntireRow, Sheets(3).Columns("C:G")).Copy .Range("C10")
  Intersect(MaPlage.EntireRow, Sheets(3).Columns("I:J")).Copy .Range("H10")
End With

A+

 

[Macpoy]

Re : Petit problème de recopie

Re,

je test cette bonne idée en rentrant du boulot.
bonne journée
merci
@plus jacques

 

[job75]

Re : Petit problème de recopie

Re,

Ah je m'étais un peu emmélé les pédales, prenez plutôt :

Set MaPlage = Sheets(3).Range("A2", Range("A200").End(xlUp).Address)
Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
With ActiveWorkbook.Sheets(4)
  MaPlage.Copy .Range("A10")
  Intersect(MaPlage.EntireRow, Sheets(3).Columns("C:G")).Copy .Range("C10")
  Intersect(MaPlage.EntireRow, Sheets(3).Columns("I:J")).Copy [COLOR="Red"].Range("I10")[/COLOR]
End With

Edit : quant à votre question :

ps: à part "variant" est ce que ces déclarations peuvent prendre une autre valeur du genre "integer"

Si toutes les cellules contiennent des valeurs Integer, pas de problème, mais si une seule contient du texte ou une valeur Long => bug.

Et si une cellule est vide, le tableau renverra 0 sur la cellule de destination...

A+

 

[Macpoy]

Re : Petit problème de recopie

Re le forum, job75

vraiment super votre modification de ma macro, elle est supersonique par rapport à la précédente.
- Humour : Mais que vais je dire à Thierry's. qui m'avais fait passer d'un copier coller cellule par cellule à la notion de " tablo " ?
on ne sait plus à quels saints se vouer !!! lorsqu'on "bricole" comme moi cet excellent logiciel.

merci pour les explications des variables.

ps : j'ai tout de même un petit soucis avec le résultat de votre macro, c'est qu'en colonne D de la feuille d'origine j'ai une formule et non pas un nombre. ce qui fait que lors de la recopie je retrouve avec un résultat faut dans la feuille de destination.

au plaisir
@ plus jacques.

 

[job75]

Re : Petit problème de recopie

Re Jacques,

ps : j'ai tout de même un petit soucis avec le résultat de votre macro, c'est qu'en colonne D de la feuille d'origine j'ai une formule et non pas un nombre. ce qui fait que lors de la recopie je retrouve avec un résultat faut dans la feuille de destination.

Pas grave, il faut enlever les formules comme suit :

Set MaPlage = Sheets(3).Range("A2", Range("A200").End(xlUp).Address)
[COLOR="Red"]MaPlage.Offset(, 3) = MaPlage.Offset(, 3).Value[/COLOR]
Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
With ActiveWorkbook.Sheets(4)
  MaPlage.Copy .Range("A10")
  Intersect(MaPlage.EntireRow, Sheets(3).Columns("C:G")).Copy .Range("C10")
  Intersect(MaPlage.EntireRow, Sheets(3).Columns("I:J")).Copy .Range("I10")
End With

A+

 

[Macpoy]

Re : Petit problème de recopie

bonsoir le forum, job75,
bon c'est super grâce à vous cette macro progresse super bien vers le résultat souhaité.
il reste cependant 1 soucis.
- il faut que je cherche la manière de mettre la colonne D de destination au
format 0000 pour obtenir par exemple 0204 . car pour le moment j'obtiens
204.
sachant que le premier chiffre sera soit 0 soit 1(en fonction du mois de l'année).

pour vous aider à comprendre mon besoin, je vous bricole 2 classeurs exemples.

ouvrir les 2 classeurs, utiliser le bouton macro du classeur de départ.


merci encore pour votre aide.

 

[Macpoy]

Re : Petit problème de recopie

bonjour le forum,

après quelques essais, j'ai trouvé la réponse au dernier petit point qui me chagrinait.

Set MaPlage = Sheets(3).Range("A2", Range("A200").End(xlUp).Address)
[COLOR=Black]
[/COLOR][B][COLOR=Red]MaPlage.Offset(, 3).NumberFormat = "0000"[/COLOR][/B]

[COLOR=Black]
MaPlage.Offset(, 3) = MaPlage.Offset(, 3).Value[/COLOR]
Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible)
With ActiveWorkbook.Sheets(4)
  MaPlage.Copy .Range("A10")
  Intersect(MaPlage.EntireRow, Sheets(3).Columns("C:G")).Copy .Range("C10")
  Intersect(MaPlage.EntireRow, Sheets(3).Columns("I:J")).Copy .Range("I10")
End With

merci beaucoup à job75 pour le coup de main.
bonne journée
@ plus jacques

 

[job75]

Re : Petit problème de recopie

Bonjour Macpoy,

Il restait pas mal de choses à compléter, voyez les fichiers joints :

- j'ai mis un bouton ActiveX à la place du bouton Formulaires

- le fichier de destination s'ouvre s'il n'est pas ouvert

- la validité du filtrage est testée, les 1ères lettres du mois suffisent

- vidage de la plage de recopie

- message et annulation si la plage de recopie n'est pas assez grande.

A+

 

[Macpoy]

Re : Petit problème de recopie

bonsoir le forum, job75,

eh bien voila après avoir "bricolé" mon classeur grâce à votre aide j'ai enfin une macro qui roule super vite.
pour la faire tourner rond, il me suffisait de modifier en amont une autre macro qui m'écrivait le nom du mois dans une colonne avec le problème des des accents.
voici donc votre macro finalisé :

Sub Recopie() 'pour la feuille vente du classeur compta
Dim F As Worksheet, Filtre$, MaPlage As Range, plage As Range
Filtre = InputBox("Filtrez un mois !")
If Filtre = "" Then
    Do While Filtre = ""
    Filtre = InputBox("vous devez choisir un mois !")
    Loop
End If



On Error Resume Next
If IsError(Workbooks(Filtre).Name) Then Workbooks.Open Filename:= _
        "G:\taratata\Comptabilité\Comptabilité 2010\M. Untel " & Filtre & " 2010.xls"
On Error GoTo 0

Vente.AutoFilterMode = False

Vente.Copy Before:=Workbooks("M. POY " & Filtre & " 2010.xls").Sheets(3)
Set F = Workbooks("M. Untel " & Filtre & " 2010.xls").Sheets(3)

If Application.CountIf(F.Range("L2:L65536"), Filtre & "*") = 0 Then
MsgBox "Mois introuvable !"
Exit Sub
End If
F.Range("L1").AutoFilter Field:=1, Criteria1:=Filtre & "*"
 
Set MaPlage = F.Range("A2", Range("A65536").End(xlUp).Address)
With MaPlage.Offset(, 3)
  .NumberFormat = "0000" 'en colonne D, on peut aussi mettre le format Texte "@"
  .Value = .Value 'supprime les formules
End With
Set MaPlage = MaPlage.SpecialCells(xlCellTypeVisible) 'plage filtrée
  
With Workbooks("M. POY " & Filtre & " 2010.xls").Sheets(4)
  Set plage = .Rows("10:" & .Range("A65536").End(xlUp).Row - 1) 'plage de recopie
  If plage.Rows.Count < MaPlage.Count Then MsgBox "Agrandissez la plage " & plage.Address & " !" 
  Intersect(.Range("A:A,C:G,I:J"), plage).ClearContents 'vide la plage de recopie
  MaPlage.Copy .Range("A10")
  Intersect(MaPlage.EntireRow, F.Columns("C:G")).Copy .Range("C10")
  Intersect(MaPlage.EntireRow, F.Columns("I:J")).Copy .Range("I10")
End With
  
Application.DisplayAlerts = False
F.Delete

End Sub

merci beaucoup pour votre aide.
au plaisir de vous recroiser sur cet excellent site.
@ plus jacques.