rinominare

[rombotuono]

Buonasera,
spiego il mio quesito.
vorrei copiare i dati presenti nel foglio formule (comprese le formule) in un'altro foglio in questo caso Br Serie A.
operazione eseguita con la registrazione macro, ma vengono visualizzati i seguenti messaggi.
https://postimg.cc/kD8D1H5X
https://postimg.cc/4n5nR9pr
mi chiede di rinominare dati1 e conv perchè già presenti nel foglio formule.
vorrei che questa rinomina venisse in automatico.
quindi foglio Br Serie A dati2 e conv1
i fogli da rinominare sono diversi, partendo sempre dal foglio formule copio in per esempio Br serieb in dati3 e conv2 ecc
quesito con registrazione macro non risolvibile.
grazie.

[Anthony47]

Puoi pubblicare il codice che usi per copiare i dati dal foglio "Formule"
Di quei nomi, che uso ne dovresti fare all'interno del foglio in cui incolli?
Ti e' chiaro che dopo un po' di copia a incolla ti ritroveresti con degli intervalli il cui nome farai fatica a capire perche' esistono e a che sono associati, vero?

[rombotuono]

questo codice importa i risultati e copia i dati dal foglio formule in atro foglio generato dal codice

Codice: Seleziona tutto

Sub importarisultati()
'buona 2023
Application.ScreenUpdating = False

Sheets("CAMP").Select
son = Cells(4, 15)
Sheets("CAMP").Select



naz = Cells(1, 12)
lega = Cells(1, 13)

stato = Sheets("Data").Columns(2).Find(naz, lookat:=xlWhole).Offset(, -1) & " " & _
    Replace(StrConv(Replace(lega, "-", " "), vbProperCase), " ", "")
If Len(stato) > 31 Then stato = Left(stato, 31)

Application.StatusBar = "Cerco dati per: " & naz & "  " & lega

' carico pagina con risultati


'Shell "RunDll32.exe Inetcpl.cpl, ClearMyTracsByProcess 8"

url1 = "https://www.betexplorer.com/football/" & naz & "/" & lega & "/results/"
Set http1 = CreateObject("MSXML2.XMLHTTP")
'Set http1 = CreateObject("MSXML2.ServerXMLHTTP")
http1.Open "POST", url1, False
''http1.send
'text1 = http1.responseText
http1.send
text1 = http1.responseText
text1 = Replace(text1, Chr(34), "")

Sheets("RIS").Select

Cells(1, 1) = naz
Cells(1, 2) = lega
' cancello foglio


For Each foglio In Worksheets
If foglio.Name = "" & stato & "" Then
GoTo 10
End If
Next foglio
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = stato

10 Sheets(stato).Select
'''''''''''''''''''''''''
   
   

'''''''''''''''''''''''''



fin = Range("A" & Rows.Count).End(xlUp).Row


If son = "S" Then
    For y = 1 To fin
       If Cells(y, 8) = "" Then
        Cells.Select
        Selection.ClearContents
        Exit For
        End If
    Next y
End If
        ' prendo l'ultimo incontro

        sq11 = Cells(1, 1): sq21 = Cells(1, 2)
        If Cells(1, 1) = "" Then GoTo 2
        controlloinc1 = "<span>" & sq11 & "</span> - <span>" & sq21 & "</span>"
        controlloinc2 = "<span><strong>" & sq11 & "</strong></span> - <span>" & sq21 & "</span>"
        controlloinc3 = "<span>" & sq11 & "</span> - <span><strong>" & sq21 & "</strong></span>"
       
         posizinc1 = InStr(1, text1, controlloinc1) - 20
         posizinc2 = InStr(1, text1, controlloinc2) - 20
         posizinc3 = InStr(1, text1, controlloinc3) - 20
         
         If posizinc1 = -20 Then posizinc1 = 1000000
         If posizinc2 = -20 Then posizinc2 = 1000000
         If posizinc3 = -20 Then posizinc3 = 1000000
         
         
         If posizinc1 > 0 And posizinc1 < posizinc2 And posizinc1 < posizinc3 Then
         posizinc2 = -20
         posizinc3 = -20
         End If
         If posizinc2 > 0 And posizinc2 < posizinc1 And posizinc2 < posizinc3 Then
         posizinc1 = -20
         posizinc3 = -20
         End If
         If posizinc3 > 0 And posizinc3 < posizinc2 And posizinc3 < posizinc1 Then
         posizinc2 = -20
         posizinc1 = -20
         End If
         
         
                       
         If posizinc1 <> -20 Then
         posizinc = posizinc1
         controlloinc = controlloinc1
         End If
         If posizinc2 <> -20 Then
         posizinc = posizinc2
         controlloinc = controlloinc2
         End If
         If posizinc3 <> -20 Then
         posizinc = posizinc3
         controlloinc = controlloinc3
         End If
         
        On Error Resume Next
         posizinc = InStr(1, text1, controlloinc) - 20
        text1 = Trim(Mid(text1, 1, posizinc))
       
        ' inizio ricerca dati
       
       
2       controllo1 = "in-match"
        ninc = (Len(text1) - Len(Replace(text1, controllo1, ""))) / Len(controllo1)
       
        If ninc = 0 Then GoTo 60
        ' inizio ricerca dati
       
       
        '-------- INIZIO MODIFICA 01/04/2021 ------
5       Range("A1:K" & fin).Select
       Selection.Copy
       Range("A" & ninc + 1).Select
       Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       Range("A1:K" & ninc).ClearContents
'5        Rows("1:" & ninc & "").Select
'        Selection.Insert Shift:=xlDown
        posin = 1
       
       
       
   
     
       
       
        For t = 1 To ninc
        Application.StatusBar = "Cerco risultati HT per: " & naz & "  " & lega & " : " & t & " di " & ninc
       
        If Cells(1, 1) = "" Then
        x = 1
        GoTo 7
        End If
        If Cells(1, 1) <> "" And Cells(2, 1) = "" Then
        x = 2
        GoTo 7
        End If
       
        Range("A1").End(xlDown).Offset(1, 0).Select
       
        x = ActiveCell.Row
        ' ricerca ris HT
       
7        If son = "N" Then GoTo 20
       
        controllolink1 = "<tr><td class="
        lenlink1 = Len(controllolink1)
        controllolink2 = "class="
        posizlink1 = InStr(posin, text1, controllolink1) + lenlink1 + 20
        posizlink2 = InStr(posizlink1, text1, controllolink2)
        linkhh = Trim(Mid(text1, posizlink1, posizlink2 - posizlink1))
       
        url1 = "https://www.betexplorer.com" & linkhh
       
'Set http1 = CreateObject("MSXML2.XMLHTTP")
Set http1 = CreateObject("MSXML2.ServerXMLHTTP")
http1.Open "POST", url1, False
http1.send
Texthh = http1.responseText
Texthh = Replace(Texthh, Chr(34), "")
       
        con1 = "js-partial"
        lencon1 = Len(con1)
        con2 = ":"
        con3 = ","
        con4 = "</h2>"
        pos1 = InStr(1, Texthh, con1) + lencon1 + 2
        testaw = Trim(Mid(Texthh, pos1, 4))
        If testaw = "nbsp" Then
        posx = InStr(1, Texthh, "js-eventstage") + 14
        testaw = Trim(Mid(Texthh, posx, 7))
        GoTo 20
        End If
        pos2 = InStr(pos1, Texthh, con2)
        If pos2 - pos1 > 5 Then GoTo 20
        pos3 = InStr(pos2, Texthh, con3)
        pos4 = InStr(pos3, Texthh, con2)
        pos5 = InStr(pos4, Texthh, con4)
        rsqh1 = Trim(Mid(Texthh, pos1, pos2 - pos1))
        rsqa1 = Trim(Mid(Texthh, pos2 + 1, pos3 - pos2 - 1))
        rsqh2 = Trim(Mid(Texthh, pos3 + 1, pos4 - pos3 - 1))
        rsqa2 = Trim(Mid(Texthh, pos4 + 1, pos5 - pos4 - 2))
       
       
       
       
       
        'sq1
       
20      controllo1 = "in-match"
        len1 = Len(controllo1)
        controllo2 = "<span>"
        len2 = Len(controllo2)
        controllo3 = "</span>"
       
        posiz1 = InStr(posin, text1, controllo1) + len1
        posiz2 = InStr(posiz1, text1, controllo2) + len2
        posiz3 = InStr(posiz2, text1, controllo3)
        sq1 = Trim(Mid(text1, posiz2, posiz3 - posiz2))
        teststrong = InStr(1, sq1, "<strong>")
        If teststrong = 1 Then
        sq1 = Replace(sq1, "<strong>", "")
        sq1 = Replace(sq1, "</strong>", "")
        End If
        'sq2
       
        posiz2 = InStr(posiz3, text1, controllo2) + len2
        posiz3 = InStr(posiz2, text1, controllo3)
        sq2 = Trim(Mid(text1, posiz2, posiz3 - posiz2))
        teststrong = InStr(1, sq2, "<strong>")
        If teststrong = 1 Then
        sq2 = Replace(sq2, "<strong>", "")
        sq2 = Replace(sq2, "</strong>", "")
        End If
       
       
       
       
        'risultato
       
        controllo4 = "/football/"
        controllo5 = ">"
        controllo6 = ":"
        controllo7 = "<"
       
        posiz1 = InStr(posiz3, text1, controllo4)
        posiz2 = InStr(posiz1, text1, controllo5) + 1
        If Trim(Mid(text1, posiz2, 1)) = "<" Then
        posin = posiz1
        Rows(x).Select
        Selection.Delete Shift:=xlUp
        GoTo 50
        End If
        posiz3 = InStr(posiz2, text1, controllo6)
       
        gsq1 = Trim(Mid(text1, posiz2, posiz3 - posiz2))
       
        posiz4 = InStr(posiz3, text1, controllo7)
        gsq2 = Trim(Mid(text1, posiz3 + 1, posiz4 - posiz3 - 1))
       
        ' quote
       
        controllo8 = "data-odd="
        len8 = Len(controllo8)
        controllo9 = ">"
        posiz5 = InStr(posiz4, text1, controllo8) + len8
        posiztest = InStr(posiz4, text1, controllo1)
       
        If posiztest <> 0 And posiztest < posiz5 Or posiz5 = 9 Then
        posiz6 = posiz4
        GoTo 30
        End If
        posiz6 = InStr(posiz5, text1, controllo9)
        quota1 = (Trim(Mid(text1, posiz5, posiz6 - posiz5)) + 1 - 1) / 100
       
        posiz5 = InStr(posiz5, text1, controllo8) + len8
        posiz6 = InStr(posiz5, text1, controllo9)
        quotax = (Trim(Mid(text1, posiz5, posiz6 - posiz5)) + 1 - 1) / 100
       
        posiz5 = InStr(posiz5, text1, controllo8) + len8
        posiz6 = InStr(posiz5, text1, controllo9)
        quota2 = (Trim(Mid(text1, posiz5, posiz6 - posiz5)) + 1 - 1) / 100
       
       
        ' scrivo dati
       
30       If testaw = "Awarded" Then
        rsqh1 = gsq1: rsqa1 = gsq2: rsqh2 = 0: rsqa2 = 0
        End If
          If testaw = "Abandon" Then
        rsqh1 = gsq1: rsqa1 = gsq2: rsqh2 = 0: rsqa2 = 0
        End If
        Cells(x, 1) = sq1
        Cells(x, 2) = sq2
        Cells(x, 3) = quota1
        Cells(x, 4) = quotax
        Cells(x, 5) = quota2
        Cells(x, 6) = gsq1
        Cells(x, 7) = gsq2
        Cells(x, 8) = rsqh1
        If Cells(x, 8) = "" Then Cells(x, 8) = gsq1
        Cells(x, 9) = rsqa1
        If Cells(x, 9) = "" Then Cells(x, 9) = gsq2
        Cells(x, 10) = rsqh2
        If Cells(x, 10) = "" Then Cells(x, 10) = 0
        Cells(x, 11) = rsqa2
        If Cells(x, 11) = "" Then Cells(x, 11) = 0
               
        rsqh1 = "": rsqa1 = "": rsqh2 = "": rsqa2 = ""
        quota1 = "": quotax = "": quota2 = ""
        posin = posiz6
50  Next t
''''''''''''''''''''''''''
60:
' parte che copia dal foglio formule
Sheets(stato).Select
 Application.ScreenUpdating = False
 verif = Sheets(stato).Range("A" & Rows.Count).End(xlUp).Row
 If verif <= 1 Then GoTo 22
Sheets("Formule").Select
    Range("A1:b1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
   
    Sheets(stato).Select
   
    Range("AA1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("AA1").Select

Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
   
    Range("AD2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.End(xlUp).Select
    Range("AD2").Select
    Selection.End(xlDown).Select
    fin = Range("AD" & Rows.Count).End(xlUp).Row + 1

    Range("AD" & fin).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlUp).Select
    Range("AD2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$AD$2:$AD$1105").RemoveDuplicates Columns:=1, Header:= _
        xlNo
    Range("AD2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets(stato).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(stato).Sort.SortFields.Add Key:=Range( _
        "AD2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets(stato).Sort
        .SetRange Range("AD2:AD25")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
   Dim Stato2 As String
   stato = Sheets("Data").Columns(2).Find(naz, lookat:=xlWhole).Offset(, -1) & " " & _
    Replace(StrConv(Replace(lega, "-", " "), vbProperCase), " ", "")
   Stato2 = "=" & "'" & stato & "'!"
   
    naz = Sheets("CAMP").Cells(1, 12)    'UCase(naz)
    lega = Sheets("CAMP").Cells(1, 13)  'UCase(lega)
    naz = UCase(naz)
    lega = UCase(lega)
   ' finale = Sheets("%").Range("A" & Rows.Count).End(xlUp).Row + 1
    TRE = Sheets(stato).Range("AC30").Value + 1
     
 
   

 
22:
''''''''''''''''''''''''''
    Sheets("DATI").Select

Application.StatusBar = ""

End Sub

[rombotuono]

parte che copia dal foglio formule

Codice: Seleziona tutto

'Sheets(stato).Select
 Application.ScreenUpdating = False
 verif = Sheets(stato).Range("A" & Rows.Count).End(xlUp).Row
 If verif <= 1 Then GoTo 22
Sheets("Formule").Select
    Range("A1:b1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
   
    Sheets(stato).Select
   
    Range("AA1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("AA1").Select

Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
   
    Range("AD2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.End(xlUp).Select
    Range("AD2").Select
    Selection.End(xlDown).Select
    fin = Range("AD" & Rows.Count).End(xlUp).Row + 1

    Range("AD" & fin).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlUp).Select
    Range("AD2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveSheet.Range("$AD$2:$AD$1105").RemoveDuplicates Columns:=1, Header:= _
        xlNo
    Range("AD2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets(stato).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(stato).Sort.SortFields.Add Key:=Range( _
        "AD2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets(stato).Sort
        .SetRange Range("AD2:AD25")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
22:
''''''''''''''''''''''''''
    Sheets("DATI").Select

Application.StatusBar = ""

[Anthony47]

Hai selezionato nel secondo messaggio la parte della macro di nostro interesse, bene.

Non hai risposto alla domanda "a che cosa ti servono questi intervalli rinominati", e la domanda sottintende l'ipotesi che non ti servono a niente.
Se così fosse, allora basterebbe fare tanti pastespecial per portare nella nuova posizione cio' che ti serve: Valori, o formule, formati e quant'altro

Se invece servono a qualcosa allora vanno ricreati partendo dalle definizioni di partenza.
Puoi avere l'elenco dei nomi attuali e delle loro definizioni eseguendo la seguente macro:

Codice: Seleziona tutto

Sub ListNames()
For I = 1 To ThisWorkbook.Names.Count
    Debug.Print ActiveWorkbook.Names(I).Name, ThisWorkbook.Names(I).RefersTo
Next I
End Sub


Dopo l'esecuzione apri la "finestra Immediata" del vba e vi troverai l'elenco dei nomi: identifica i nomi di cui parliamo e la loro descrizione e pubblica l'informazione nel tuo prossimo messaggio; indica anche se i nuovi nomi devono essere visibili in tutti i fogli o possono essere "locali" al singolo foglio.

Ciao

[rombotuono]

ciao
posto il file eseguendo la macro importarisultati vengono mostrati i messaggi di rinomina dati1 e conv.
questqa richiesta avviene tutte la volte che viene creato un nuovo foglio.
i fogli da creare sono diversi, quindi la macro visualizza sempre di rinominare sul nuovo foglio creato dati1 e conv.
chiaramente con nomi diversi da data1 conv.
https://www.mediafire.com/file/2p7z120b ... a.zip/file
grazie

[Anthony47]

Continuo a chiedere a cosa servono gli intervalli modificati ma tu continui a non rispondere.
Ho pensato che potessero servire a basta, ma dall’analisi del file che hai pubblicato non mi sono fatto una idea convincente della situazione.

Per cominciare ci sono ampi pezzi della Sub importarisultati che non riesco a decodificare; ad esempio a un certo punto aggiungi un foglio (ovviamente all’inizio e’ vuoto), e su questo foglio cominci una serie di operazioni incomprensibili o piu' semplicemente inutili:
-cerchi una cella vuota in colonna H
-quando la trovi (e la trovi su riga1, ovviamente) cancelli tutto il foglio (gia' vuoto)
-poi procedi con “prendo l'ultimo incontro”, che ovviamente non c’e’, e procedi con GoTo 2
-qui credo che stimi quanti “incontri” sono presenti nel Response.Text della query fatta (ninc = etc etc)
-cio' fatto procedi con le istruzioni del blocco “(INIZIO MODIFICA 01/04/2021” e copi il Range("A1:K" & fin) (cioe’ copi niente, essendo il foglio appena creato), accodandolo il niente agli incontri che stai per importare
-comincia finalmente l’importazione degli incontri sul foglio vuoto appena creato

Completata l’importazione, cominciano le Copia /Incolla
-la prima “Copia” riguarda le prime tre righe del foglio Formule; ed e’ qui che compare il messaggio sul conflitto dei nomi, perche’ i due intervalli intersecano la selezione copiata.

TUTTAVIA:
-a me sembra che il problema nasca dalla presenza di “Nomi” in errore sul tuo file (almeno sul file pubblicato):

Codice: Seleziona tutto

'Nomi Iniziali:
'Nome                     Ambito        Riferito a
_xlfn.AGGREGATE..........prova.xlsb.....=#NAME?
_xlfn.BASE...............prova.xlsb.....=#NAME?
_xlfn.COUNTIFS...........prova.xlsb.....=#NAME?
_xlfn.IFERROR............prova.xlsb.....=#NAME?
_xlfn.SHEETS.............prova.xlsb.....=#NAME?
Formule!CONVAL...........Formule........=OFFSET(Formule!$AC$1,0,0,30-COUNTBLANK(Formule!$AC$1:$AC$30),1)
CONVAL...................prova.xlsb.....=OFFSET('C:\Users\UTENTE\OneDrive\Desktop\[statistica.xlsb]SERIE A'!$AC$1,0,0,30-COUNTBLANK('C:\Users\UTENTE\OneDrive\Desktop\[statistica.xlsb]SERIE A'!$AC$1:$AC$30),1)
CONVAL1..................prova.xlsb.....=OFFSET(Formule!$AC$1,0,0,30-COUNTBLANK(Formule!$AC$1:$AC$30),1)
DATA_AWAY................prova.xlsb.....='C:\Users\UTENTE\OneDrive\Desktop\[statistica.xlsb]Base'!$H$3:$O$700
DATA_HOME................prova.xlsb.....='C:\UTENTE\lucia\OneDrive\Desktop\[statistica.xlsb]Base'!$I$3:$O$700
Formule!Data1............Formule........=Formule!$A$3:$Q$600
Data1....................prova.xlsb.....='C:\Users\UTENTE\OneDrive\Desktop\[statistica.xlsb]SERIE A'!$A$3:$Q$600
Data2....................prova.xlsb.....=#REF!$A$3:$Q$600


Ignora i nomi che cominciano con _XLFN
In particolare ci sono dei “Nomi” che hanno origine su file esterni e uno con origine in errore #REF

Se cancelliamo questi “Nomi” anomali e poi eseguiamo la Sub importarisultati la macro si esegue completamente (a parte l’errore su Sheets("DATI").Select, poiche’ nel file demo manca il file DATI, e la situazione dei Nomi e’ la seguente:

Codice: Seleziona tutto

'Dopo import:
'Nome                     Ambito        Riferito a
_xlfn.AGGREGATE..........prova.xlsb.....=#NAME?
_xlfn.BASE...............prova.xlsb.....=#NAME?
_xlfn.COUNTIFS...........prova.xlsb.....=#NAME?
_xlfn.IFERROR............prova.xlsb.....=#NAME?
_xlfn.SHEETS.............prova.xlsb.....=#NAME?
'BR SerieA'!CONVAL.......BR SerieA......=OFFSET(Formule!$AC$1,0,0,30-COUNTBLANK(Formule!$AC$1:$AC$30),1)
Formule!CONVAL...........Formule........=OFFSET(Formule!$AC$1,0,0,30-COUNTBLANK(Formule!$AC$1:$AC$30),1)
CONVAL1..................prova.xlsb.....=OFFSET(Formule!$AC$1,0,0,30-COUNTBLANK(Formule!$AC$1:$AC$30),1)
'BR SerieA'!Data1........BR SerieA......='BR SerieA'!$A$3:$Q$600
Formule!Data1............Formule........=Formule!$A$3:$Q$600


Come vedi, e’ stato copiato il “Nome CONVAL con Ambito=Foglio Formule”, ed e’ diventato “CONVAL con Ambito=BR SerieA”
Altre copie produrranno altri nomi CONVAL con “ambito” limitato al foglio di destinazione, quindi che non interferiscono tra di loro perche’ ognuno ha un ambito limitato

Non so se l’operazione di “pulizia” suddetta dara’ anche a te gli stessi risultati, ma devi provare tu
Quindi prova e fai sapere...

D:\DDownloads\[prova.xlsb]Data

[rombotuono]

grazie
la macro è in costruzione, tutto quello elencato da te: copia nulla ecc verra risolto.
quando importo i dati sul foglio creato da codice a prescindere daggli errori che verrano sistemati in un secondo momento.
quindi questa riga TRE = Sheets(stato).Range("AC30").Value + 1 si può commentare perchè ancora in costruzione come il foglio dati non presente.
il problema creando il nuovo foglio br serie a se controlli in be1 c'è un menu a discesa senza il nome conv non funziona come non funziona il range dati1 perchè non presente nel foglio br serie a appena creato.
il problema è copiare il tutto dal foglio formule compreso dati1 e conv nel nuovo foglio e su quelli che verrano creati oltre a br serie a. gli errori verrano risolti.
in conclusione generando nuovi fogli devono essere presenti sempre dati1 e conv. bisogna vedere se poi vanno in conflitto, in questo caso dovranno avere un altro nome.
sembra che non ci siano via d'uscita, il problema sembra non risolvibile.

[Anthony47]

Se cancelliamo questi “Nomi” anomali e poi eseguiamo la Sub importarisultati la macro si esegue completamente (a parte l’errore su Sheets("DATI").Select, poiche’ nel file demo manca il file DATI
[....]
Come vedi, e’ stato copiato il “Nome CONVAL con Ambito=Foglio Formule”, ed e’ diventato “CONVAL con Ambito=BR SerieA”
Altre copie produrranno altri nomi CONVAL con “ambito” limitato al foglio di destinazione, quindi che non interferiscono tra di loro perche’ ognuno ha un ambito limitato

Non so se l’operazione di “pulizia” suddetta dara’ anche a te gli stessi risultati, ma devi provare tu
Quindi prova e fai sapere...

in conclusione generando nuovi fogli devono essere presenti sempre dati1 e conv. bisogna vedere se poi vanno in conflitto, in questo caso dovranno avere un altro nome.
sembra che non ci siano via d'uscita, il problema sembra non risolvibile.

Scusa, ma hai provato?

[rombotuono]

si ho provato con la pulizia dei nomi lanciando la macro termina il ciclo ma purtroppo non copia data1 e conv.
stessa operazione eseguita con la registrazione macro, ma vengono visualizzati i seguenti messaggi.
https://postimg.cc/kD8D1H5X
https://postimg.cc/4n5nR9pr.
quindi niente data1 e conv
comunque grazie.
cercherò altre soluzioni.

[Anthony47]

Dopo che hai completato il lavoro lancia questa macro:

Codice: Seleziona tutto

Sub ListNamesXa()
For I = 1 To ThisWorkbook.Names.Count
    nn = ActiveWorkbook.Names(I).Name
    ggg = TypeName(ActiveWorkbook.Names(I).Parent)
    hhh = ActiveWorkbook.Names(I).Parent.Name
    Debug.Print nn & String(25 - Len(nn), ".") & hhh & String(15 - Len(hhh), ".") & ThisWorkbook.Names(I).RefersTo
Next I
End Sub


Poi pubblica quello che trovi registrato sulla "finesta Immediata" del vba (per visualizzarla: dal vba, usa la combinazione Contr-g, oppure Menu /Visualizza /Finestra Immdiata)

[rombotuono]

grazie

[Anthony47]

Con quella macro avrei voluto farti vedere che i "Nomi" sono presenti anche sui nuovi fogli, e si chiamano NomeFoglio!CONVAL e NomeFoglio!Dati1, con "ambito" pari al foglio di lavoro. E' possibile che per CONVAL sia sbagliata l'area a cui il nuovo nome fa riferimento, perche' il nome e' copiato con i suoi attributi ma i dati vengono probabilmente incollati in posizione diversa (colonna AC nel foglio di partenza, colonna AD nel nuovo foglio); ma correggere il "riferimento" (sapendo dove sono i dati) non e' complicato e si fa facilmente; ma la posizione per ora e' equivoca, perche' le aree di due Copia/Incolla per ora sono sovrapposte, immagino faccia parte delle cose ancora da sistemare, e sistemate quelle si puo' finalmente vedere di aggiustare i riferimenti dei nomi.

Se invece a te i Nomi non risultano presenti allora la cosa e' effettivamente piu' confusa...

[rombotuono]

ancora grazie
provo