Copiare in foglio già aperto

[Gianca532011]

Ciao a tutti,
Forse è il neurone che è stressato, forse l'età o forse l'insieme dei due fattori ???
Comunque il problema è questo : devo copiare un foglio xls che ho in C:\Users\Giancarlo\Downloads\ nel foglio aperto dal quale lancio la macro ( file UL_1A_Bilanci_MS_Selenium.xlsm") cioè nel foglio DatiMS. Con la macro sotto riesco a selezionare il foglio da cui copiare , seleziono l'area e poi mi blocco , ovvero non riesco a interagire con il foglio già aperto e copiare la mia tabella . Dove sbaglio ?
Qui il codice

Codice: Seleziona tutto

Public Sub SelezionaFileEsterno()
    Dim LastRow As Long
    Dim LastColumn As Long
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    NomeFileConMacro = ThisWorkbook.Name

    Dim fDialog As Office.FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    Dim selezione As Variant
    Dim Last_Col As Long, Last_Row As Long
    Dim Destination_file As Workbook
    Dim PercorsoEstrazioniAntex As String
    Percorso = ThisWorkbook.Path & "C:\Users\Giancarlo\Downloads\"    'DA MODIFICARE

    With fDialog
        .AllowMultiSelect = False
        .Title = "Seleziona il file da aprire"
        .InitialFileName = Percorso
        Set Destination_file = Workbooks("UL_1A_Bilanci_MS_Selenium.xlsm")

        If .Show = -1 Then
            For Each selezione In .SelectedItems
                FileDaAprire = selezione
                Application.Workbooks.Open (FileDaAprire)
                NomeFileDaAprire = ActiveWorkbook.Name

                Last_Col = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
                Last_Row = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

                Range(Cells(1, Last_Col), Cells(Last_Row, Last_Col)).Copy
'-------------------------------------------------------------------------------------------
' fino a qui va bene ora dovrebbe copiare nel file già aperto Destination_file nel foglio DatiMS
             Workbooks.Open Destination_file
             ActiveWorkbook.SaveCopyAs Filename:=Sheets("DatiMS").Select
                   Sheets("DatiMs").Cells(1, 1).PasteSpecial Operation:=xlPasteValues

'----------------------------------------------------------------------------------------
                 Next
        Else
            MsgBox "Operazione annullata!", vbInformation

            Application.EnableEvents = True
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            Exit Sub
        End If
    End With

    Set selezione = Nothing
    Set fDialog = Nothing

End Sub




[Gianca532011]

Ero proprio fuso ! Sorry, richiesta annullata.
Qui sotto la macro "aggiustata" e funzionante con tutti i riferimenti del caso.

Codice: Seleziona tutto

Option Explicit
Sub SelezionaFileEsterno() ' e importa dati
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim fDialog As Office.FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    Dim selezione As Variant
    Dim Last_Col As Long, Last_Row As Long
    'Dim sWb As String
    Dim FileDaAprire
    Dim NomeFileDaAprire As String
    Dim NomeFileconMacro As Workbook
  ' Dim dSh As Worksheet   ' foglio di destinazione
    Dim percorso As String
       
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

   Set NomeFileconMacro = ThisWorkbook

   percorso = ThisWorkbook.Path & "C:\Users\Giancarlo\Downloads\"    'DA MODIFICARE
   
    Set dSh = Sheets("DatiMs")   ' da modificare
    dSh.Range("a1:H1000").Clear
   
    With fDialog
        .AllowMultiSelect = False
        .Title = "Seleziona il file da aprire"
        .InitialFileName = percorso

        If .Show = -1 Then
            For Each selezione In .SelectedItems
                FileDaAprire = selezione
                Application.Workbooks.Open (FileDaAprire)
                NomeFileDaAprire = ActiveWorkbook.Name
                               
                Last_Col = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
                Last_Row = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

                ActiveSheet.Range(Cells(1, 1), Cells(Last_Row, Last_Col)).Copy dSh.Range("a1")

                'Chiude il file Sorgente:
               ActiveWorkbook.Close
               
            Next
        Else
            MsgBox "Operazione annullata!", vbInformation

            Application.EnableEvents = True
            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            Exit Sub
        End If
    End With

    Set selezione = Nothing
    Set fDialog = Nothing

End Sub




[Raffaele53]

Ormai fatto ed allego

Codice: Seleziona tutto

Option Explicit
Sub SelezionaFileEsterno()
    Dim LastRow As Long
    Dim LastColumn As Long
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim W1 As Workbook: Set W1 = Workbooks("UL_1A_Bilanci_MS_Selenium.xlsm") ' da cambiare casomai
    Dim F1 As Worksheet: Set F1 = W1.Worksheets("DatiMS") ' da cambiare casomai
    Dim W2 As Workbook
    Dim F2 As Worksheet
    Dim fDialog As Office.FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    Dim selezione As Variant
    Dim Last_Col As Long, Last_Row As Long
    Dim Percorso As String
    Dim FileDaAprire As String
    Dim NomeFileConMacro As String
    NomeFileConMacro = ThisWorkbook.Name
    'Percorso = ThisWorkbook.Path & "C:\Users\Giancarlo\Downloads\"    'DA MODIFICARE
    Percorso = ThisWorkbook.Path & "C:\Users\artur\Downloads\"    'DA MODIFICARE
        With Application.FileDialog(msoFileDialogOpen)
            .InitialFileName = Percorso
            .Title = "Seleziona file"
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count = 0 Then MsgBox "Operazione annullata!", vbInformation: GoTo Fine
            FileDaAprire = .SelectedItems(1)
        End With
        Set W2 = Workbooks.Open(FileDaAprire)
'--------------Qui secondo me dovresti sapere da quale foglio prendere i dati, oppure metti W2.Worksheets(1)
                Set F2 = W2.Worksheets(1) ' il nome del foglio
'--------------da adesso in poi Ti devi riferire mettendo davanti F1 o F2 ex
                Last_Col = F2.Cells(1, Columns.Count).End(xlToLeft).Column
                Last_Row = F2.Cells(Rows.Count, 1).End(xlUp).Row
                F2.Range(F2.Cells(1, Last_Col), F2.Cells(Last_Row, Last_Col)).Copy
               
                F1.Cells("NON SO DOVE INCOLLARE").PasteSpecial
                W2.Workbooks.Close
'Ps Meglio mettere queste righe alla fine
Fine:
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set F1 = Nothing
Set F2 = Nothing
Set W1 = Nothing
Set W2 = Nothing
End Sub