Changer la feuille de travail excel

Fermé
nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020 - Modifié le 3 janv. 2018 à 11:17
nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020 - 5 janv. 2018 à 11:05
Bonjour mes chers amis;

Je viens de finir une macro qui travaille sur deux feuils spécifiques:

input: c'est ou j'ai les données.
Output: c'est ou je recois le résultat final.

j'ai essayé de rendre la macro exploitable sur un seul feuil:
doc je dois recevoir le résultat dans le même feuil: Input.

Voilà le message que je recois après quelques essaye;

Set ws = Sheets("Input")
Set sh = Sheets("Output")



Le code Macro:

Sub NETTOYAGE()
Dim sh As Worksheet
Dim ws As Worksheet
Dim a As Long
Dim b As Long


Set ws = Sheets("Input")
Set sh = Sheets("Output")

b = ws.Range("A1").End(xlDown).Row
c = sh.Range("A1").End(xlDown).Row
sh.Activate
sh.Range("A2", Cells(c, "I")).Clear
'sh.Range("A2", Cells(c, "I")).Interior.Color = RGB(255, 255, 255)
For a = 2 To b
sh.Cells(a, "C") = ws.Cells(a, "C")
sh.Cells(a, "A") = ws.Cells(a, "G")
sh.Cells(a, "E") = ws.Cells(a, "I")
sh.Cells(a, "B") = ws.Cells(a, "L")
sh.Cells(a, "G") = ws.Cells(a, "M")
sh.Cells(a, "D") = ws.Cells(a, "X")


Next
sh.Range("A2", Cells(b, "A")).NumberFormat = "dd/mm/yyyy;@"

Dim maplageC As Range

Set maplageC = sh.Range("G2", Cells(b, "G"))

For Each cellule In maplageC
  If cellule.Value > 0 Then
     sh.Cells(cellule.Row, 6).Value = "C"
  Else
    sh.Cells(cellule.Row, 6).Value = "D"
    
    End If

Next


Range("H2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-4],SEARCH("".TIF"",RC[-4])-8,8)"
Selection.Copy
Range("G60000").End(xlUp).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("D2").Select
ActiveCell.FormulaR1C1 = "=RC[4]"
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Columns("H:H").ClearContents
Columns("D:D").EntireColumn.AutoFit
Range("A2").Select


Columns("A:G").Select
Selection.AutoFilter
ActiveSheet.Range("$A:$G").AutoFilter Field:=7, Criteria1:=">0", Operator:=xlAnd
Range("G60000").End(xlUp).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]"
Selection.Copy
Range(Selection, Range("H2")).Select
ActiveSheet.Paste
Selection.AutoFilter

Columns("H:H").Copy
Range("H1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

ActiveSheet.Range("$A:$H").AutoFilter Field:=7, Criteria1:=">0", Operator:=xlAnd
        
Columns("G:G").SpecialCells(xlCellTypeVisible).ClearContents
Selection.AutoFilter

Columns("G:G").Select
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Range("A60000").End(xlUp).Offset(0, 8).Select
Selection = "E"
Selection.Copy
Range(Selection, Range("I2")).Select
ActiveSheet.Paste

Application.CutCopyMode = False








End Sub
    
    
    
    
Sub test()



End Sub







EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.
A voir également:

1 réponse

yg_be Messages postés 22699 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
5 déc. 2017 à 11:14
bonjour, quel message reçois-tu?
je suggère de supprimer les activate et select qui te restent.
et, surtout, de toujours indiquer la feuille sur laquelle tu travailles, donc éviter des range ou column sans rien devant.
et, encore, d'éviter autant que possible d'utiliser le presse-papier.
0
nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
5 déc. 2017 à 11:23
je recois un message Débogage est ces lignes en jaune:
Set ws = Sheets("Input")
Set sh = Sheets("Output")

Maintement est ce que vous pouvez me faire ces modifications car je ne suis pas un diveloppeur, je juste bricole.

Merci
0
yg_be Messages postés 22699 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471 > nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
5 déc. 2017 à 11:27
as-tu bien deux feuilles appelées Input et Output dans ton classeur?
si oui, le message "Débogage" contient plein d'information utiles.
0
nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
5 déc. 2017 à 11:38
Oui exact j'ai deux classeurs, et les informations dans "Débogage" j'ai les publiés dans le sujet pour votre aide?
0
yg_be Messages postés 22699 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471 > nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
5 déc. 2017 à 12:42
quand tu as l'erreur "débogage", ne reçois-tu pas une boite de dialogue? cette boite de dialogue contient un texte utile.
0
nonossov Messages postés 611 Date d'inscription lundi 29 décembre 2014 Statut Membre Dernière intervention 17 janvier 2020
3 janv. 2018 à 11:11
elle m'affiche ce msg en jaune:

Set sh = Sheets("Output")
ou

si je renomme la fieul "input" je recois le meme msg pour input

Set sh = Sheets("Input")
0