Modifica Macro Salva

Hai un problema con Excel?

Nuova discussione

Modifica Macro Salva
di genoa68 data: 10/01/2013 19:45:38
Ciao HerryBosch,ti chiedo ancora aiuto(se possibile),ho modificato la tua routine per salvare piu dati e piu colonne con un altro range di partenza ma lo stesso di arrivo su un altro foglio"PULIZIA".Funziona fino a quando arrivo all' ultima colonna disponibile del foglio IV dove c'è la data di settembre siccome devo salvare dati fino al 31dicembre, ho ricopiato la griglia di continuazione calendario a partire dalla cella h69

immagino che devo modificare questa istruzione Set rng = .Range(.[h2], .Cells(2, .[h2].CurrentRegion.Columns.Count)) 'per dirgli se non trovi la data sopra vai a cercarla dalla h69 in poi e salva. Ho provato ad aggiungere il range h69 cells69 h69 ma forse sbaglio sintassi o metodo perchè non funziona.
Ps. Perche' se sposto il pulsante che attiva la routine in un altro foglio non funziona?

Ps.Ho aperto una discussione perche' non so',visto che "macro salva dati tra due fogli" risultando risolta si deve fare cosi.
Grazie Marco

Sub Salva_PULIZIA()
'   Salva_PULIZIA Macro
    Dim rngdati As Range, rng As Range, cella As Range
    Dim data(28), col(28)
    Dim c As Integer, diff As Integer, riga As Integer
    Application.ScreenUpdating = False

    For c = 1 To 28
    Cells(1, c + 28).Select
        data(c) = CDate(Cells(1, c + 28))
    Next c
         Set rngdati = Range("ac2:bd" & Cells(Rows.Count, 2).End(xlUp).Row)
With Sheets("PULIZIA")
         Set rng = .Range(.[h2], .Cells(2, .[h2].CurrentRegion.Columns.Count))
             For Each cella In rng
                For c = 1 To 28
                If cella.Value = data(c) Then
                    col(c) = cella.Column
                End If
            Next c
        Next
               For c = 1 To 28
                       diff = -2 - c
                      If cella <> "" Then
                        On Error Resume Next
                          riga = .Columns(1).Find(cella.Offset(, diff).Value, LookIn:=xlValues).Row
                    .Cells(riga, col(c)) = cella.Value
                End If
            Next
        Next c
          End With
    MsgBox "Inserimento effettuato"
    Application.ScreenUpdating = True
End Sub

Macro inclusa in ogni nuovo file
di luigi (utente non iscritto) data: 10/01/2013 19:55:16
Salve.

Mi piacerebbe poter disporre di un comando (tastiera o barra multifunzione) già disponibile su ogni nuovo file (2010).

Il codice che vorrei che excel caricasse ad ogni apertura è questo:

Cells.Select
Selection.Delete Shift:=xlUp
ActiveWindow.DisplayGridlines = False
Range("A1").Select

Come è evidente serve ad avere il foglio alleggerito di celle e senza griglia.
Credo che occorra qualcosa in apertura di file che non è Sub (), ma altro.
Essendo ignorantissimo non so cosa.

Grazie comunque per la collaborazione.
di HarryBosch data: 10/01/2013 20:40:46
Luigi, devi postare la tua richiesta su un nuovo thread visto che hai continuato la discussione aperta da un altro utente.
Grazie.
di luigi (utente non iscritto) data: 10/01/2013 20:44:55
Ops!
Pardon!
di HarryBosch data: 11/01/2013 19:02:43
Mi sembra che manchi un For Each nell'ultimo ciclo, rispetto alla routine dell'altra volta.
Per il resto mi sembrerebbe corretto.

di genoa68 (utente non iscritto) data: 11/01/2013 23:09:09
Mi sono accorto della mancanza ,avevo trascritto male.
Cmq non mi copia i dati, cercando la data da h69 in poi quando quest' ultima non è presente nella seconda riga del foglio.

Sub Salva_Pulizia()
Dim rngdati As Range, rng As Range, cella As Range
    Dim data(28), col(28)
    Dim c As Integer, diff As Integer, riga As Integer
    Application.ScreenUpdating = False
For c = 1 To 28
    Cells(1, c + 28).Select
        data(c) = CDate(Cells(1, c + 28))
    Next c
Set rngdati = Range("ac2:bd" & Cells(Rows.Count, 2).End(xlUp).Row)
   With Sheets("PULIZIA")
 Set rng = .Range(.[h2], .Cells(2, .[h2].CurrentRegion.Columns.Count))
        For Each cella In rng
            For c = 1 To 28
                If cella.Value = data(c) Then
                    col(c) = cella.Column
                End If
            Next c
        Next
        For c = 1 To 28
            diff = -2 - c
            For Each cella In rngdati.Columns(c).Cells
                If cella <> "" Then
                    On Error Resume Next
                    riga = .Columns(1).Find(cella.Offset(, diff).Value, LookIn:=xlValues).Row
                    .Cells(riga, col(c)) = cella.Value
                End If
                  Next
            Next c
 End With
    MsgBox "Inserimento effettuato"
    Application.ScreenUpdating = True
End Sub

Vuoi Approfondire?