VBA da modificare

Hai un problema con Excel?

Nuova discussione

VBA da modificare
di ERMES.MAZ data: 13/12/2014 01:29:29
Ciao ragazzi...

Riporto una parte si formula in VBA... che ha il difetto di funzionare solo se sono nel foglio 6.

Come devo fare per far si che mi funzionano su tutti i fogli?

Anzichè ("6") che devo mettere???

    ActiveWorkbook.Worksheets("6").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("6").Sort.SortFields.Add Key:=Range("AV15"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("6").Sort

di lepat (utente non iscritto) data: 13/12/2014 08:14:17
prova così

Sub a()
For Each ws In ActiveWorkbook.Worksheets
  ws.Sort.SortFields.Clear
  ws.Sort.SortFields.Add Key:=Range("AV15"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ws.Sort
.......
Next
End Sub

di ERMES.MAZ data: 13/12/2014 16:06:39
Sino a stasera non riuscirò a provare...

Mah... Semplicemente non c'è un comando che sostituisce il comando foglio 6... ("6") con tutti i fogli?
di lepat (utente non iscritto) data: 13/12/2014 16:35:43
magari se cerchi bene lo trovi ... io ti rispondo per quello che so.
di ERMES.MAZ data: 13/12/2014 17:24:40
E io ti ringrazio per la tua gentilezza...

La mia.era semplice curiosita da persona che non conosce il linguaggio
di ERMES.MAZ data: 13/12/2014 18:11:06
Ciao Lepat...

ho cambiato:

ActiveWorkbook.Worksheets("6").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("6").Sort.SortFields.Add Key:=Range("AV15"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("6").Sort

con:

For Each ws In ActiveWorkbook.Worksheets
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=Range("AV15"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort

e mi da il seguente messaggio:

Errore di compilazione

Variabile di controllo For già in uso

Che devo fare?
di lepat (utente non iscritto) data: 13/12/2014 22:14:26
allega il file

di ERMES.MAZ data: 14/12/2014 00:21:26
Ecco... Questa è la macro completa!

Sul foglio 6 funziona, su gli altri fogli da errore

Sub StampOrdALFAB_Francione()

    ActiveSheet.Unprotect
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("AD13").Select


    Range("AC17:AJ34").Select
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=16
    Range("AM17").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=8
    Range("AV12").Select
    ActiveSheet.Paste
    Range("AV17").Select
    ActiveSheet.Paste
    Range("AV12:BC16").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("AV15:BC34").Select
    ActiveWorkbook.Worksheets("6").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("6").Sort.SortFields.Add Key:=Range("AV15"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("6").Sort
        .SetRange Range("AV15:BC34")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("AV15:BC32").Select
    Selection.Copy
    Range("AC17").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("AC40:AJ46").Select
    Selection.Copy
    Range("AM40").Select
    ActiveSheet.Paste
    Range("AV37").Select
    ActiveSheet.Paste
    Range("AV40").Select
    ActiveSheet.Paste
    Range("AV37:BC39").Select
    Application.CutCopyMode = False
    Selection.Cut
    Range("AV37:BC39").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("AV37:BC46").Select
    ActiveWorkbook.Worksheets("6").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("6").Sort.SortFields.Add Key:=Range("AV37"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("6").Sort
        .SetRange Range("AV37:BC46")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("AV37:BC43").Select
    Selection.Copy
    Range("AC40").Select
    ActiveSheet.Paste
    
    
    ActiveWindow.SmallScroll Down:=39
    Range("AA76").Select
    ActiveWindow.SmallScroll Down:=-48
    Range("A25").Select
    Selection.Copy
    Range("A19").Select
    ActiveSheet.Paste
    Range("A24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A25").Select
    ActiveSheet.Paste
    Range("F5:R6").Select
    Application.CutCopyMode = False
   
    
    
    Dim NumeroCopie As Integer
    NumeroCopie = Range("V54")
    ActiveWindow.SelectedSheets.PrintOut Copies:=NumeroCopie, Collate:=True
    
    
    Range("A19").Select
    Selection.Copy
    Range("A25").Select
    ActiveSheet.Paste
    Range("A24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A19").Select
    ActiveSheet.Paste
    
    
   Range("AM17:AT34").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC17").Select
    ActiveSheet.Paste
    Range("AM40:AT46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AC40").Select
    ActiveSheet.Paste
    Columns("AL:BD").Select
    Range("AL10").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("AD13").Select
    
          Range( _
        "E13,G13,I13,K13,M13,O13,Q13,Q17:Q34,O17:O34,M17:M34,K17:K34,I17:I34,G17:G34,E17:E34,AD40:AJ46,AD17:AJ34,AD13:AJ13" _
        ).Select
    Range("AD13").Activate
    ActiveWindow.SmallScroll Down:=30
    Range( _
        "E13,G13,I13,K13,M13,O13,Q13,Q17:Q34,O17:O34,M17:M34,K17:K34,I17:I34,G17:G34,E17:E34,AD40:AJ46,AD17:AJ34,AD13:AJ13,V54,Y54,D80:S80" _
        ).Select
    Range("D80").Activate
    ActiveWindow.SmallScroll Down:=-24
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveWindow.SmallScroll Down:=-51
    Range("AD13").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    
End Sub

di ERMES.MAZ data: 16/12/2014 06:08:12
Nessuno che sa come aiutarmi??

La.domanda è sempre la stessa...

Come sostituisco il comando "lavora su foglio 6" con il comando "lavora su foglio attivo"?

E... Come faccio a dire alla macro... Copiami il range "a1:b2" del foglio precedente a quello attivo sul foglio attivo?

Grazie
di lepat (utente non iscritto) data: 16/12/2014 07:42:25
hai denunciato un Errore di compilazione e ti ho chiesto di allegare il file, l'hai fatto ?
di ERMES.MAZ data: 16/12/2014 11:11:01
Scusa Lepat...

Ho allegato l'intera macro... E giusto sopra....

La mia richiesta è come faccio a far funzionare la macro realizzata sui fogli attivi e non solo sul foglio 6.
di ERMES.MAZ data: 17/12/2014 06:15:04
Ho trovato la soluzione alle mie domande...

Ho visto che il registratore si comporta diversamente tra excell 2003 e 2010.

Aprirò un topic a riguardo.

Ciao a tutti.

Vuoi Approfondire?