Condividi tramite

Macro Copia Incolla Cartelle di Lavoro diverse

Anonimo
2016-09-05T14:56:11+00:00

Ciao a tutti,

sto cercando una macro che mi permetta di copiare e incollare un foglio da una cartella di lavoro ad un altra.

Dato che il nome della cartella di lavoro da cui attingere il foglio (che ha sempre lo stesso nome) cambia giornalmente avevo pensato ad una finestra che mi permetta di selezionare il file dentro la quale c'è il foglio che devo copiare ed incollare nella prima riga libera in un altro foglio nella cartella di lavoro da cui parte la macro.

Help me !!

Troppo complicato per me

Grazie a tutti

Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti Nessun commento

Risposta accettata dall'autore della domanda

Anonimo
2016-09-05T15:28:38+00:00

Questa macro, che va copia/incollata in un modulo standard del file dove verranno incollati i dati, fa questa cosa.

  • Apre il file che le indicherai
  • Copia i dati dal Foglio1
  • Li incolla nel Foglio1 del file dove hai la macro
  • Chiude il file dal quale hai copiato

Public Sub m()

On Error GoTo RigaErrore

Dim sPathNome As String

    Dim wkMe As Workbook

    Dim wk As Workbook

    Dim sh As Worksheet

    Dim shMe As Worksheet

    Dim rng As Range

    Dim lRiga As Long

sPathNome = Application.GetOpenFilename( _

        "Excel Files (*.xls; *.xlsx; *.xlsm),*.xls; *xlsx; *.xlsm", _

        , "Selezionare il file")

Application.ScreenUpdating = False

Set wkMe = ThisWorkbook

    Set shMe = wkMe.Worksheets("Foglio1")

    Set wk = Workbooks.Open(sPathNome)

    Set sh = wk.Worksheets("Foglio1")

    Set rng = sh.Range("A1").CurrentRegion

    rng.Copy

    With shMe

        lRiga = .Range("A" & .Rows.Count).End(xlUp).Row + 1

        .Range("A" & lRiga).PasteSpecial

        Application.CutCopyMode = False

    End With

        wk.Close

    Application.ScreenUpdating = True

RigaChiusura:

    Set wkMe = Nothing

    Set shMe = Nothing

    Set wk = Nothing

    Set sh = Nothing

    Set rng = Nothing

    Exit Sub

RigaErrore:

    If Err.Number <> 1004 Then

        MsgBox Err.Number & vbNewLine & Err.Description

    End If

    Resume RigaChiusura

End Sub

Modifica le parti in grassetto con i tuoi riferimenti.

La risposta è stata utile?

0 commenti Nessun commento

5 risposte aggiuntive

Ordina per: Più utili
  1. Anonimo
    2016-09-08T09:57:31+00:00

    Senza sapere cosa fanno le macro chiamate dai Call, difficile rispondere.

    Prova a condividere il file su OneDrive o, se ha dati sensibili, via mail qui:

    maurogsc

    chiocciola

    alice.it

    La risposta è stata utile?

    0 commenti Nessun commento
  2. Anonimo
    2016-09-08T09:48:57+00:00

    Ciao Mauro e ciao a tutti

    ho un problema con questa macro !

    Nella cartella di lavoro in "ThisWorkbook" ho questo codice

    Private Sub Workbook_SheetActivate(ByVal sh As Object)

        Call f(sh.Name)

        Call i(sh.Name)

        Call m(sh.Name)

        Call p(sh.Name)

    End Sub

    mi serve per copiare in automatico dei dati di un foglio su x fogli al verificarsi di determinate condizioni

    Public Sub f(ByVal s As String)

    'Dichiarazione variabili

        Dim rng As Range

        Dim c As Range

        Dim nr As Long

        Dim lr As Long

        If s = "I Decade" Then Exit Sub

        Application.ScreenUpdating = False

        lr = Worksheets(s).Range("A65536").End(xlUp).Row

         Worksheets("00").Range("A30:H200").ClearContents

         Worksheets("01").Range("A30:H200").ClearContents

         Worksheets("02").Range("A30:H200").ClearContents

    ..........

    Quando avvio la macro mi da un errore riconducibile  qui perché se disabilito i "Call" funziona perfettamente.

    C'è soluzione? Magari disabilitando temporaneamente il Workbook per permettergli di copiare?

    Lo so sono ignorante!

    La risposta è stata utile?

    0 commenti Nessun commento
  3. Anonimo
    2016-09-06T14:27:19+00:00

    Bene e grazie a te per il cortese riscontro.

    Ciao e alla prossima.

    La risposta è stata utile?

    0 commenti Nessun commento
  4. Anonimo
    2016-09-06T14:19:14+00:00

    Ciao Mauro volevo solo ringraziarti perché funziona perfettamente ed è proprio quello che mi serviva!

    La risposta è stata utile?

    0 commenti Nessun commento