Problema nel copiare dati da un file all'altro

[FROST220684Partecipante FROST220684]

Ciao a tutti ho un piccolo problema nel copiare i dati da un file all'altro:

ho un codice che effettua il copia incolla di una tabella da un file ad altri 2 che sono identici. Fin qui tutto bene il codice funzionava perfettamente.

Ora ho voluto aggiungere alcune righe codice per copiare una sola cella sempre da un file ad altri 2. Il codice funziona fino alla parte della tabella e va anche a buon fine (nel senso che se apro gli altri 2 file dopo l'errore mi ritrovo i dati cambiati) ma quando passa al copiare questa cella mi da un errore strano che non riesco a comprendere. La macro incriminata è Sub Copiadati():

1. primo passaggio vengono copiate le celle A:J nei due fogli tabelle prezzi

2. secondo passaggio dovrebbe copiare la cella A89 del foglio Output negli altri 2 file sempre nei fogli output

3. terzo passaggio dovrebbe copiare la cella A87 del foglio Output Weekend negli altri 2 file sempre nei fogli output weekend

il codice modificato è questo:

`Public Sub CopiaDati()
 
    'dichiaro le variabili
    Dim wk1 As Workbook
    Dim wk2 As Workbook
    Dim wk3 As Workbook
    Dim wk4 As Workbook
    Dim wk5 As Workbook
    Dim wk6 As Workbook
    Dim wk7 As Workbook
    Dim wk8 As Workbook
    Dim wk9 As Workbook
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
    Dim sh4 As Worksheet
    Dim sh5 As Worksheet
    Dim sh6 As Worksheet
    Dim sh7 As Worksheet
    Dim sh8 As Worksheet
    Dim sh9 As Worksheet
    Dim V As Variant

'gestione errori
On Error GoTo RigaErrore
 
    Application.ScreenUpdating = False
 
    'metto i riferimenti ai files
    Set wk1 = ThisWorkbook
    Set wk2 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 fabio.xlsm")
    Set wk3 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 federica.xlsm")
    Set wk4 = ThisWorkbook
    Set wk5 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 fabio.xlsm")
    Set wk6 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 federica.xlsm")
    Set wk7 = ThisWorkbook
    Set wk8 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 fabio.xlsm")
    Set wk9 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 federica.xlsm")
    'metto i riferimenti ai fogli
    Set sh1 = wk1.Worksheets("Tabelle Prezzi")
    Set sh2 = wk2.Worksheets("Tabelle Prezzi")
    Set sh3 = wk3.Worksheets("Tabelle Prezzi")
    Set sh4 = wk4.Worksheets("Output")
    Set sh5 = wk5.Worksheets("Output")
    Set sh6 = wk6.Worksheets("Output")
    Set sh7 = wk7.Worksheets("Output Weekend")
    Set sh8 = wk8.Worksheets("Output Weekend")
    Set sh9 = wk9.Worksheets("Output Weekend")
 
    With sh1
        'copio i dati da un file all'altro
        .Range("A:J").CurrentRegion.Copy Destination:=sh2.Range("A1")
        
    End With
    For Each V In wk2.LinkSources(Type:=xlLinkTypeExcelLinks)
        wk2.BreakLink Name:=V, Type:=xlLinkTypeExcelLinks
    Next
    wk2.Save
    wk2.Close
'Elimino i collegamenti ai nuovi file e salvo e chiudo
    With sh1
    .Range("A:J").CurrentRegion.Copy Destination:=sh3.Range("A1")
    End With
    For Each V In wk3.LinkSources(Type:=xlLinkTypeExcelLinks)
        wk3.BreakLink Name:=V, Type:=xlLinkTypeExcelLinks
        Next
    wk3.Save
    wk3.Close
   Worksheets("Output").Select
   With sh4
        'copio i dati da un file all'altro
        .Range("A:D").CurrentRegion.Copy Destination:=sh5.Range("A89")
        
    End With
    For Each V In wk5.LinkSources(Type:=xlLinkTypeExcelLinks)
        wk5.BreakLink Name:=V, Type:=xlLinkTypeExcelLinks
    Next
    wk5.Save
    wk5.Close
'Elimino i collegamenti ai nuovi file e salvo e chiudo
    With sh4
    .Range("A:D").CurrentRegion.Copy Destination:=sh6.Range("A89")
    End With
    For Each V In wk6.LinkSources(Type:=xlLinkTypeExcelLinks)
        wk6.BreakLink Name:=V, Type:=xlLinkTypeExcelLinks
        Next
    wk6.Save
    wk6.Close
    Worksheets("Output Weekend").Select
    With sh7
        'copio i dati da un file all'altro
        .Range("A:D").CurrentRegion.Copy Destination:=sh8.Range("A87")
        
    End With
    For Each V In wk8.LinkSources(Type:=xlLinkTypeExcelLinks)
        wk8.BreakLink Name:=V, Type:=xlLinkTypeExcelLinks
    Next
    wk8.Save
    wk8.Close
'Elimino i collegamenti ai nuovi file e salvo e chiudo
    With sh7
    .Range("A:D").CurrentRegion.Copy Destination:=sh9.Range("A87")
    End With
    For Each V In wk9.LinkSources(Type:=xlLinkTypeExcelLinks)
        wk9.BreakLink Name:=V, Type:=xlLinkTypeExcelLinks
        Next
    wk9.Save
    wk9.Close
    
 
    Application.ScreenUpdating = True
 

RigaChiusura:
   
    Set sh2 = Nothing
    Set sh1 = Nothing
    Set sh3 = Nothing
    Set sh4 = Nothing
    Set sh5 = Nothing
    Set sh6 = Nothing
    Set sh7 = Nothing
    Set sh8 = Nothing
    Set sh9 = Nothing
    Set wk1 = Nothing
    Set wk2 = Nothing
    Set wk3 = Nothing
     Set wk4 = Nothing
    Set wk5 = Nothing
    Set wk6 = Nothing
     Set wk7 = Nothing
    Set wk8 = Nothing
    Set wk9 = Nothing
    Exit Sub
 
'in caso di errore
RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura
 
End Sub
`

vi allego errore e file prova

Grazie a tutti

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

ho modificato alcune cose nel codice adesso mi dice errore di automazione non so perchè, mi sembra tutto corretto

[alexps81Moderatore alexps81 Karma: 58 pts]

Ho dato un rapido sguardo ma bisogna approfondire bene prima di provare a risolvere.

Da quello che vedo pare che tu stai cercando di copiare dati da alcuni fogli di un file principale su altri fogli di file secondari.

Ora, partendo dal foglio "TABELLA PREZZI", tu hai scritto:

    With sh1
        'copio i dati da un file all'altro
        .Range("A:J").CurrentRegion.Copy Destination:=sh2.Range("A1")
        
    End With

ma con Range("A:J").CurrentRegion cosa vorresti che sia copiato? Da quello che vedo scritto nel foglio, con questa istruzione copi praticamente tutto il foglio in quanto ogni "zona" è collegata con l'altra. Perciò, se la tua intenzione è copiare praticamente tutto il foglio ti basta anche Range("A1").CurrentRegion.Copy

Nei fogli "OUTPUT" e "OUTPUTWEEKEND", tu hai scritto:

Range("A:D").CurrentRegion.Copy

qui invece copia effettivamente solo il range  "A1:D3"...è corretto?

Poi ho notato tante dichiarazioni di variabili che puntano a vari fogli (sheets) e cartelle di lavoro (workbooks)...ma soprattutto wk1, wk4 e wk7 puntano tutte e tre a ThisWorkbook...è inutile. ne basta una di variabile...e forse nemmeno serve se la inglobi nella variabile sh scrivendo semplicemente: Set sh1 = Application.ThisWorkbook.WorkSheets("Tabelle Prezzi")

    Set wk1 = ThisWorkbook '<-----
    Set wk2 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 fabio.xlsm")
    Set wk3 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 federica.xlsm")
    Set wk4 = ThisWorkbook '<-----
    Set wk5 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 fabio.xlsm")
    Set wk6 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 federica.xlsm")
    Set wk7 = ThisWorkbook '<-----
    Set wk8 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 fabio.xlsm")
    Set wk9 = Workbooks.Open("C:\Users\Eurolido\Desktop\Nuova cartella\Profit Holiday 1.0 federica.xlsm")

Diciamo che servirebbero anche gli altri 2 file...ma se sono uguali a questo allora per i test si posso creare da questo e rinominarli. Poi dimmi tu se sono diversi.

Ora ammettiamo che sono sulla strada giusta...vedo che i 3 file risiedono tutti nel medesimo percorso: "C:\Users\Eurolido\Desktop\Nuova cartella\"

Se è così potremmo pensare a un ciclo che apre questi 2 file e procedere a fare i vari Copia/Incolla...però bisogna capire bene prima il risultato che si vuole ottenere. Quindi quali sono i range/celle da copiare e dove incollare; i file risiedono tutti e sempre nello stesso percorso? Se sì...qual 'è, questo indicato?

[FROST220684Partecipante FROST220684]

alexps81 ha scritto:

Da quello che vedo pare che tu stai cercando di copiare dati da alcuni fogli di un file principale su altri fogli di file secondari.

Ciao Alex si esattamente ed i file sono identici e si trovano tutti in cartelle/destinazioni diverse ma per provare io ho creato una cartella ed ho messo dentro i 2 file dove vanno copiate le info mentre il file originale era sul desktop.

alexps81 ha scritto:

ma con Range("A:J").CurrentRegion cosa vorresti che sia copiato? Da quello che vedo scritto nel foglio, con questa istruzione copi praticamente tutto il foglio in quanto ogni "zona" è collegata con l'altra.

In realtà questa parte del codice che è quella iniziale funziona e copia tutte le colonne da A a J del foglio Tabelle Prezzi per copiarle sempre nello stesso posto nei file secondari e si ferma alla prima riga vuota.

alexps81 ha scritto:

Nei fogli "OUTPUT" e "OUTPUTWEEKEND", tu hai scritto:

Range("A:D").CurrentRegion.Copy

qui invece copia effettivamente solo il range  "A1:D3"...è corretto?

In realtà questo è un codice ampliato da me e come ti dicevo non sono bravo a semplificare e quindi sicuramente ci sono variabili in più inutili. Il ragionamento degli altri 2 fogli è più semplice ma è proprio quello che non funziona:

1. Copiare la cella A89 del foglio output negli altri due file sempre in A89 e sempre nel foglio output

2. Copiare la cella A87 del foglio output weekend negli altri due file sempre in A87 e sempre nel foglio output weekend

alexps81 ha scritto:

Diciamo che servirebbero anche gli altri 2 file...ma se sono uguali a questo allora per i test si posso creare da questo e rinominarli. Poi dimmi tu se sono diversi.

Esattamente

alexps81 ha scritto:

Ora ammettiamo che sono sulla strada giusta...vedo che i 3 file risiedono tutti nel medesimo percorso: "C:\Users\Eurolido\Desktop\Nuova cartella\"

No non risiedono nello stesso posto ma in percorsi diversi e come se fosse strutturato così

1. File originale in A

2. Primo file secondario in B

3. Secondo file secondario in C

[alexps81Moderatore alexps81 Karma: 58 pts]

Ma li puoi lasciare nella stessa cartella? Non per forza tutti e tre, almeno gli altri 2 (Federica.xlsm e Fabio.xlsm).

Oppure devi averli in cartelle diverse?

[FROST220684Partecipante FROST220684]

in cartelle diverse per ogni operatore ha il suo percorso, ma cmq la prima parte del codice quello inerente al foglio Tabelle Prezzi era funzionante, non funziona sulla restante parte codice.

Per intenderci questo funziona:

Public Sub CopiaDati()
 
    'dichiaro le variabili
    Dim wk1 As Workbook
    Dim wk2 As Workbook
    Dim wk3 As Workbook
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
    Dim V As Variant

'gestione errori
On Error GoTo RigaErrore
 
    Application.ScreenUpdating = False
 
    'metto i riferimenti ai files
    Set wk1 = ThisWorkbook
    Set wk2 = Workbooks.Open("Z:\Altri computer\Il mio computer\Archivio\UFFICO BOOKING\PROVA FILE UNICO\OPERATORI\FABIO\Preventivi FABIO 9.0.xlsm")
    Set wk3 = Workbooks.Open("Z:\Altri computer\Il mio computer\Archivio\UFFICO BOOKING\PROVA FILE UNICO\OPERATORI\LUIGI PALERMO\Preventivi LUIGI 9.0.xlsm")
    'metto i riferimenti ai fogli
    Set sh1 = wk1.Worksheets("Tabelle Prezzi")
    Set sh2 = wk2.Worksheets("Tabelle Prezzi")
    Set sh3 = wk3.Worksheets("Tabelle Prezzi")
 
    With sh1
        'copio i dati da un file all'altro
        .Range("A:J").CurrentRegion.Copy Destination:=sh2.Range("A1")
        
    End With
    For Each V In wk2.LinkSources(Type:=xlLinkTypeExcelLinks)
        wk2.BreakLink Name:=V, Type:=xlLinkTypeExcelLinks
    Next
    wk2.Save
    wk2.Close
'Elimino i collegamenti ai nuovi file e salvo e chiudo
    With sh1
    .Range("A:J").CurrentRegion.Copy Destination:=sh3.Range("A1")
    End With
    For Each V In wk3.LinkSources(Type:=xlLinkTypeExcelLinks)
        wk3.BreakLink Name:=V, Type:=xlLinkTypeExcelLinks
        Next
    wk3.Save
    wk3.Close
   
    
 
    Application.ScreenUpdating = True
 

RigaChiusura:
   
    Set sh2 = Nothing
    Set sh1 = Nothing
    Set sh3 = Nothing
    Set wk1 = Nothing
    Set wk2 = Nothing
    Set wk3 = Nothing
    Exit Sub
 
'in caso di errore
RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura
 
End Sub

[alexps81Moderatore alexps81 Karma: 58 pts]

Va bene...allora sostituisci il tuo codice con questo nuovo:

`Option Explicit

Public Sub CopiaDati()
Dim NomeFile As String
Dim wb As Variant, v As Variant
Dim wb1 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim Percorso1 As String, Percorso2 As String, NomeFile1 As String, NomeFile2 As String, sSplit As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'gestione errori
On Error GoTo RigaErrore

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Tabelle Prezzi")
Set ws2 = wb1.Sheets("Output")
Set ws3 = wb1.Sheets("Output WeekEnd")

Percorso1 = "C:\Users\Eurolido\Desktop\Nuova cartella\" '<--Stringa del 1° percorso
Percorso2 = "C:\Users\Eurolido\Desktop\Nuova cartella\" '<--String del 2° percorso
NomeFile1 = "Profit Holiday 1.0 fabio.xlsm" '<--Nome del 1° file
NomeFile2 = "Profit Holiday 1.0 federica.xlsm" '<--Nome del 2° file

sSplit = Percorso1 & NomeFile1 & "¶" & Percorso2 & NomeFile2

For Each wb In Split(sSplit, "¶")

    Workbooks.Open wb
    With ActiveWorkbook
        .Sheets("Tabelle Prezzi").Activate
        ws1.Range("A1").CurrentRegion.Copy Destination:=Range("A1")
        
        .Sheets("Output").Activate
        Range("A89") = ws2.Range("A89")
    
        .Sheets("Output WeekEnd").Activate
        Range("A87") = ws3.Range("A87")
    
        For Each v In ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
            ActiveWorkbook.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
        Next
                
        .Save
        .Close
    End With
Next wb

MsgBox "Finito.", vbInformation, "Dati copiati"

RigaChiusura:
Set wb1 = Nothing
Set ws1 = Nothing: Set ws2 = Nothing: Set ws3 = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

'in caso di errore
RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura

End Sub
`

assicurati di indicare nelle variabili Percorso1 e Percorso2 i percorsi dei 2 file. Inoltre anche i nomi dei 2 file, compresa l'estensione .xlsm, devono essere scritte correttamente in NomeFile1 e NomeFile2

Fammi sapere se funge.

 

EDIT: @Frost mi è stato suggerito dalla nostra "Luce" comune   di sostituire la virgola "," nella variabile sSplit e nel ciclo For Each con questo "¶"

quindi aggiorna il codice con questo carattere dove ti ho indicato.

[FROST220684Partecipante FROST220684]

alexps81 ha scritto:

Va bene...allora sostituisci il tuo codice con questo nuovo:

come al solito sembra funzionare tutto 🙂 grazieeeee

ho aggiunto solo un active sul foglio input in modo che i file secondari quando li apro mi ripartono da questo foglio se no partivano dall'ultimo foglio modificato e cioè output weekend.

alexps81 ha scritto:

EDIT: @Frost mi è stato suggerito dalla nostra "Luce" comune   di sostituire la virgola "," nella variabile sSplit e nel ciclo For Each con questo "¶"

quindi aggiorna il codice con questo carattere dove ti ho indicato.

penso che poi hai deciso di modificare tu perchè funziona tutto ed il carattere "¶" è presente. giusto io non devo fare nulla

 

grazie a te ed alla nostra luce che è sempre omnipresente

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

alexps81 ha scritto:

EDIT: @Frost mi è stato suggerito dalla nostra "Luce" comune   di sostituire la virgola "," nella variabile sSplit e nel ciclo For Each con questo "¶"

FROST220684 ha scritto:

grazie a te ed alla nostra luce che è sempre omnipresente

Questo e' stalking   

Comunque un altro carattere inusuale va benissimo, anche la pipe o barra col buco "|" (su alcune tastiere e con alcuni font c'e' veramente un buco in mezzo al carattere). A me piace il segno di paragrafo "¶" ma e' solo un gusto personale.

[FROST220684Partecipante FROST220684]

vecchio frac ha scritto:

Questo e' stalking   

Ma se ti adoriamo ahahah

Una birra non ci sta?

🤣🤣🤣🤣🤣

[FROST220684Partecipante FROST220684]

Io non lo so cosa ho combinato ma funzionava tutto ora invece mi da errore non corrispondente fermandosi al foglio output weekend e lasciandomi aperto il primo file e si blocca.

ho modificato il codice cosi ma non penso di aver fatto danni:

Option Explicit

Public Sub CopiaDatiOK()
Dim NomeFile As String
Dim wb As Variant, v As Variant
Dim wb1 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim Percorso1 As String, Percorso2 As String, NomeFile1 As String, NomeFile2 As String, sSplit As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'gestione errori
On Error GoTo RigaErrore

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Tabelle Prezzi")
Set ws2 = wb1.Sheets("Output")
Set ws3 = wb1.Sheets("Output WeekEnd")

Percorso1 = "C:\Users\Eurolido\Desktop\Nuova cartella\" '<--Stringa del 1° percorso
Percorso2 = "C:\Users\Eurolido\Desktop\Nuova cartella\" '<--String del 2° percorso
NomeFile1 = "Profit Holiday 1.0 fabio.xlsm" '<--Nome del 1° file
NomeFile2 = "Profit Holiday 1.0 federica.xlsm" '<--Nome del 2° file

sSplit = Percorso1 & NomeFile1 & "¶" & Percorso2 & NomeFile2

For Each wb In Split(sSplit, "¶")

     Workbooks.Open wb
    With ActiveWorkbook
        .Sheets("Tabelle Prezzi").Activate
        ws1.Range("A1").CurrentRegion.Copy Destination:=Range("A1")
        
        .Sheets("Output").Activate
        Range("A89") = ws2.Range("A89")
    
        .Sheets("Output WeekEnd").Activate
        Range("A87") = ws3.Range("A87")
        .Sheets("Tabelle Prezzi").Visible = False
        .Sheets("Input").Activate
    
        For Each v In ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
            ActiveWorkbook.BreakLink Name:=v, Type:=xlLinkTypeExcelLinks
        Next
                
        .Save
        .Close
    End With
Next wb

MsgBox "Finito.", vbInformation, "Dati copiati"

RigaChiusura:
Set wb1 = Nothing
Set ws1 = Nothing: Set ws2 = Nothing: Set ws3 = Nothing
Sheets("Tabelle Prezzi").Visible = False
Sheets("Input").Activate
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

'in caso di errore
RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura

End Sub

ti posto il file con cui mi da l'errore magari riesci a capire cosa ho combinato mannaia

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

aggiungo di aver fatto varie prove, anche a ripartire dal codice originale (nemmeno quello funziona), ma niente è come se fosse cambiato qualcosa nel foglio che non trova corrispondenza ma non riesco a capire cosa

[alexps81Moderatore alexps81 Karma: 58 pts]

Prova questo:

Option Explicit

Public Sub CopiaDati()
Dim NomeFile As String
Dim wb As Variant, v As Variant
Dim wb1 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim Percorso1 As String, Percorso2 As String, NomeFile1 As String, NomeFile2 As String, sSplit As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'gestione errori
On Error GoTo RigaErrore

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Tabelle Prezzi")
Set ws2 = wb1.Sheets("Output")
Set ws3 = wb1.Sheets("Output WeekEnd")

Percorso1 = "Z:\Altri computer\Il mio computer\Archivio\UFFICO BOOKING\PROVA FILE UNICO\OPERATORI\FABRIZIO\" '<--Stringa del 1° percorso
Percorso2 = "Z:\Altri computer\Il mio computer\Archivio\UFFICO BOOKING\PROVA FILE UNICO\OPERATORI\LUIGI PALERMO\" '<--String del 2° percorso
NomeFile1 = "Profit Holiday 1.0 FABRIZIO.xlsm" '<--Nome del 1° file
NomeFile2 = "Profit Holiday 1.0 LUIGI.xlsm" '<--Nome del 2° file

sSplit = Percorso1 & NomeFile1 & "¶" & Percorso2 & NomeFile2

For Each wb In Split(sSplit, "¶")

    Workbooks.Open wb
    With ActiveWorkbook
        .Sheets("Tabelle Prezzi").Activate
        ws1.Range("A1").CurrentRegion.Copy Destination:=Range("A1")
        .Sheets("Tabelle Prezzi").Visible = False
        
        .Sheets("Output").Activate
        Range("A89") = ws2.Range("A89")
    
        .Sheets("Output WeekEnd").Activate
        Range("A87") = ws3.Range("A87")
        
        .Sheets("Input").Activate
        
        If Not IsEmpty(.LinkSources(xlExcelLinks)) Then
            For Each v In .LinkSources(xlExcelLinks)
                .BreakLink v, xlLinkTypeExcelLinks
            Next v
        End If
        
        .Save
        .Close
    End With
Next wb

ws1.Visible = False
Sheets("Input").Activate
wb1.Save

MsgBox "Finito.", vbInformation, "Dati copiati"

RigaChiusura:
Set wb1 = Nothing
Set ws1 = Nothing: Set ws2 = Nothing: Set ws3 = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

'in caso di errore
RigaErrore:
    MsgBox Err.Number & vbNewLine & Err.Description
    Resume RigaChiusura

End Sub

gli dava fastidio la non presenza di Collegamenti Esterni (che originariamente avevi).

Ho modificato questa parte di codice:

If Not IsEmpty(.LinkSources(xlExcelLinks)) Then
    For Each v In .LinkSources(xlExcelLinks)
        .BreakLink v, xlLinkTypeExcelLinks
    Next v
End If

ho anche sistemato la parte in cui attivi e nascondi i fogli dei fari file.

Prova e fammi sapere.

[FROST220684Partecipante FROST220684]

Sinceramente? Misteri della fede non capisco sinceramente la parte dei collegamenti che prima c'erano ed adesso no.

quella parte di codice l'avevo messa proprio perchè si creavano dei collegamenti che davano fastidio mah    stavo uscendo pazzo

cmq già provato funziona perfettamente

grazie mille alex

[FROST220684Partecipante FROST220684]

Ciao Alex,

Ho un problema con questa parte di codice che mi sovrascrive tutto il foglio partendo da A1, ed essendo che in (m17:m20) ho delle formule quando effettuo la copia dei dati probabilmente non riesce a copiare le formule e me le cancella:

Workbooks.Open wb
    With ActiveWorkbook
        .Sheets("Tabelle Prezzi").Activate
        ws1.Range("A1").CurrentRegion.Copy Destination:=Range("A1")
        .Sheets("Tabelle Prezzi").Visible = False

ho provato a modificare il range con ("A:J") per copiare solo quelle colonne e non arrivare alla colonna M ma non funziona. Cosa sbaglio?

Grazie mille

[alexps81Moderatore alexps81 Karma: 58 pts]

Forse perché stai provando così:

ws1.Range("A:J").CurrentRegion.Copy Destination:=Range("A1")

mentre dovresti scrivere:

ws1.Range("A:J").Copy Destination:=Range("A1")

[Marius44Moderatore Marius44 Karma: 58 pts]

Salve a tutti

Non ho letto tutto ma siamo sicuri dell'ampiezza dell'intervallo da copiare? Onestamente le intere colonne A:J mi sembrano proprio tante, troppe celle.

Ciao,

Mario

[FROST220684Partecipante FROST220684]

Perfetto come sempre risolutivo

Grazieeeee

[FROST220684Partecipante FROST220684]

Beh io non me ne intendo molto ma mi pare di capire che nonostante l'intervallo A:J appena la macro trova una riga vuota ferma il suo input di copia anche perché è molto veloce nella sua esecuzione contando che nella versione definitiva copia le celle su 5 file diversi e ci mette circa 10/15 secondi.

[alexps81Moderatore alexps81 Karma: 58 pts]

Si chiaramente il mio era solo un suggerimento perché ho intuito che tu stessi cercando di copiare l'intervallo A:J affidantoti al metodo CurrentRegion

Ma Marius ha ragione...il range è molto ampio. Se la sua ampiezza varia di volta in volta allora puoi ricavarti l'ultima cella piena in una variabile (di esempi ne hai abbastanza nel file allegato...ur =Cells(Rows.Count, "A")......) è poi trasformare il range in Range("A1:J" & ur)

Altrimenti se già lo conosci lo puoi definire direttamente. Per esempio....Range("A1:J100")...ma questo la devi stabile tu secondo le tue esigenze.

 

[Autore]

Articoli