Collegamento esterno

Hai un problema con Excel?

Nuova discussione

Collegamento esterno
di Alessio (utente non iscritto) data: 15/03/2012
Salve, vi posto parte del codice che uso all'interno di una cartella di lavoro.

volevo cercare di far copiare i dati su una nuova cartella che si apre in automatico nel quale c'è uno sheets chiamato rifin.
praticamente quello che fa adesso solo che non sulla solita cartella di lavoro ma su una cartella diversa.
grazie

For Each trovacodice In ActiveWorkbook.Sheets


Sheets("Foglio1").Select


trovacodice = Application.WorksheetFunction.CountIf(Range("b4:b20000"), "RIF")

If trovacodice <> 0 Then

Range("b3").Select
Do
ActiveCell.Offset(1).Select
Loop Until ActiveCell.Value = "RIF"
ActiveCell.Offset(0, 0).Select
X = ActiveCell.Address
cliente = ActiveCell.Value
ActiveCell.Offset(0, 43).Select

Taglia = ActiveCell.Value
Y = ActiveCell.Address
Taglia = ActiveSheet.Name
Range(X & ":" & Y).Select
Selection.Cut
Sheets("RIFIN").Select
Range("b8").Select
Do
ActiveCell.Offset(1).Select
Loop Until ActiveCell.Value = ""
Sheets("RIFIN").Paste




    End If

Next

di 1.618 (utente non iscritto) data: 17/03/2012
Prova con questo codice.
ps: cmq il tuo codice non fa il copia/incolla ma il taglia/incolla
cià tonella

Sub copia_in()
Range("b3").Select
For Each trovacodice In ActiveWorkbook.Sheets
    Sheets("foglio1").Select
    trovacodice = Application.WorksheetFunction.CountIf(Range("b4:b20000"), "RIF")
    If trovacodice <> 0 Then
        Range("b3").Select
        Do
            ActiveCell.Offset(1).Select
        Loop Until ActiveCell.Value = "RIF"
        ActiveCell.Offset(0, 0).Select
        X = ActiveCell.Address
        cliente = ActiveCell.Value
        ActiveCell.Offset(0, 43).Select
        Taglia = ActiveCell.Value
        Y = ActiveCell.Address
        Taglia = ActiveSheet.Name
        Range(X & ":" & Y).Select
        Selection.Cut
        'cambiare Pippo con il percorso di dove si trova la cartella
        'cambiare Pluto con il nome del file su cui si trova il foglio RIFIN
        Workbooks.Open Filename:="C:PIPPOPLUTO.xls"
        Sheets("RIFIN").Select
        Range("b8").Select
        Do
            ActiveCell.Offset(1).Select
        Loop Until ActiveCell.Value = ""
        Sheets("RIFIN").Paste
    End If
'poi non sò in che fase vuoi chiudere e/o salvare il file Pluto
'ma di seguito ti allego il codice per chiuderlo e salvarlo
'(se non lo volessi salvare basta sostituire il true con il false
Workbooks("pluto.xls").Close SaveChanges:=True
Next
End sub

Vuoi Approfondire?