errore di run time 1004 metodo range dell'oggetto _global non riuscito

Question

Ciao a tutti,

ho realizzato la seguente macro che a volte va in errore ma andando in debug prosegue in maniera corretta l'elaborazione e non riesco a capire il motivo

Quello che fa è

->chiedere 2 date

->poi applico il filtro tra le 2 date

->selezione delle colonne (c,d,l,m)

->copio le colonne  in uno sheet vuoto

->elimino i duplicati.

l'errore accade nelle selezione delle colonne (evidenziato in grassetto)

non so come risolvere il problema,avete delle idee.

ciao a tutti e grazie 

Vito

qui di seguito il codice

Sub NEW_PROGETTI_ANELLI()

On Error GoTo RIAVVIO

Sheets("Componenti_Anelli").Select

RIAVVIO:

    dt1 = InputBox("ISERISICI DATA INIZIALE PER I NUOVI PROGETTI EMESSI DD/MM/YYYY")

    dt2 = InputBox("ISERISICI DATA FINALE PER I NUOVI PROGETTI EMESSI DD/MM/YYYY")

    If VBA.IsDate(dt1) And VBA.IsDate(dt2) Then

        If ActiveSheet.AutoFilterMode Then

            If ActiveSheet.FilterMode Then

                ActiveSheet.ShowAllData

            End If

        End If

    ActiveSheet.Range("A:Z").AutoFilter Field:=13, Criteria1:=">=" & Format(dt1, "mm/dd/yy"), Operator:= _

        xlAnd, Criteria2:="<=" & Format(dt2, "mm/dd/yy")

ThisWorkbook.Sheets("Componenti_Anelli").Range("C:C,D:D,L:L,M:M").Select

    Range("M1").Activate

    Selection.Copy

    Sheets("PROGETTI_EMESSI").Select

    Range("A1").Activate

    ActiveSheet.Paste

    Application.CutCopyMode = False

    ActiveSheet.Range("$A$1:$D$1028705").RemoveDuplicates Columns:=Array(1, 2, 3, 4) _

        , Header:=xlYes

    Range("A1").Select

    Sheets("Componenti_Anelli").Select

        If ActiveSheet.AutoFilterMode Then

            If ActiveSheet.FilterMode Then

                ActiveSheet.ShowAllData

            End If

        End If

    Range("A1").Select

     ActiveSheet.Range("A:Z").AutoFilter Field:=14, Criteria1:=">=" & Format(dt1, "mm/dd/yy"), Operator:= _

        xlAnd, Criteria2:="<=" & Format(dt2, "mm/dd/yy")

  ThisWorkbook.Sheets("Componenti_Anelli").Range("C:C,D:D,L:L,N:N").Select

    Range("N1").Activate

    Selection.Copy

    Sheets("ANELLI_POC_OA").Select

    Range("A1").Activate

    ActiveSheet.Paste

    Application.CutCopyMode = False

    ActiveSheet.Range("$A$1:$D$1028705").RemoveDuplicates Columns:=Array(1, 2, 3, 4) _

        , Header:=xlYes

    Range("A1").Select

    Else

        MsgBox ("FORMATO NON CORRETTO")

        GoTo RIAVVIO:

    End If

End Sub

Answer 1

Ciao Vito,

io non posso inserire il modulo nell'altro file.

Io dovrei copiare i dati presenti nel file x dello sheet Componenti_Anelli ed incollare la seleziona multipla nel file y sheet PROGETTI_EMESSI.

In assenza di file di esempio, prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub NEW_PROGETTI_ANELLI()

    Dim srcWB As Workbook, destWB As Workbook

    Dim SrcSH As Worksheet, destSH As Worksheet, destSH2 As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim Res1 As Variant, Res2 As Variant

    Const sFileFonte As String = "Pippo.xlsx"

    Const sFoglioDati As String = "Componenti_Anelli"

    Const sFoglioDestinazione As String = "PROGETTI_EMESSI"

    Const sFoglioDestinazione2 As String = "ANELLI_POC_OA"

    Const sMsg As String = "ISERISICI DATA "

    Const sMsg2 As String = "PER I NUOVI PROGETTI" _

          & "EMESSI DD/MM/YYYY"

    Const sColonneSorgente As String = "A:Z"

    Set srcWB = Workbooks(sFileFonte)

    Set destWB = ThisWorkbook

    Set SrcSH = srcWB.Sheets(sFoglioDati)

    With destWB

        Set destSH = .Sheets(sFoglioDestinazione)

        Set destSH2 = .Sheets(sFoglioDestinazione2)

    End With

    Set srcRng = SrcSH.Range(sColonneSorgente)

    Do Until IsDate(Res1)

        Res1 = InputBox(sMsg & " INIZIALE " & sMsg2)

        If StrPtr(Res1) = 0 Then

            Call MsgBox( _

                 Prompt:="Hai cancellato - Riprova!", _

                 Buttons:=vbCritical, _

                 Title:="REPORT")

            Exit Sub

        ElseIf Not IsDate(Res1) Then

            Call DataIncorretta

        End If

    Loop

    Do Until IsDate(Res2)

        Res2 = InputBox(sMsg & " FINALE " & sMsg2)

        If StrPtr(Res1) = 0 Then

            MsgBox "Hai cancellato!"

            Exit Sub

        ElseIf Not IsDate(Res1) Then

            Call DataIncorretta

        End If

    Loop

    With SrcSH

        If .AutoFilterMode Then

            If .FilterMode Then

                .ShowAllData

            End If

        End If

        srcRng.Cells(1).AutoFilter _

                Field:=13, _

                Criteria1:=">=" & Format(Res1, "mm/dd/yy"), _

                Operator:=xlAnd, _

                Criteria2:="<=" & Format(Res2, "mm/dd/yy")

        .Range("M1").Copy Destination:=destSH.Range("A1")

        destSH.Range("$A$1:$D$1028705").RemoveDuplicates _

                Columns:=Array(1, 2, 3, 4), _

                Header:=xlYes

        If .AutoFilterMode Then

            If .FilterMode Then

                .ShowAllData

            End If

        End If

        srcRng.Cells(1).AutoFilter Field:=14, _

                                   Criteria1:=">=" _

                                              & Format(Res1, "mm/dd/yy"), _

                                   Operator:=xlAnd, _

                                   Criteria2:="<=" & Format(Res2, "mm/dd/yy")

        .Range("N1").Copy Destination:=destSH2.Range("A1")

        destSH2.Range("$A$1:$D$1028705").RemoveDuplicates _

                Columns:=Array(1, 2, 3, 4), _

                Header:=xlYes

    End With

End Sub

'--------->>

Public Sub DataIncorretta()

    Const sMsg As String = "FORMATO NON CORRETTO"

    Call MsgBox( _

         Prompt:=sMsg, _

         Buttons:=vbInformation, _

         Title:="AVVISO")

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Ciao Vito,

Ciao a tutti,

ho realizzato la seguente macro che a volte va in errore ma andando in debug prosegue in maniera corretta l'elaborazione e non riesco a capire il motivo

Quello che fa è 

->chiedere 2 date 

->poi applico il filtro tra le 2 date

->selezione delle colonne (c,d,l,m)

->copio le colonne  in uno sheet vuoto

->elimino i duplicati.

l'errore accade nelle selezione delle colonne (evidenziato in grassetto)

non so come risolvere il problema,avete delle idee.

ciao a tutti e grazie 

Vito

qui di seguito il codice

Sub NEW_PROGETTI_ANELLI()

On Error GoTo RIAVVIO

Sheets("Componenti_Anelli").Select

RIAVVIO:

    dt1 = InputBox("ISERISICI DATA INIZIALE PER I NUOVI PROGETTI EMESSI DD/MM/YYYY")

    dt2 = InputBox("ISERISICI DATA FINALE PER I NUOVI PROGETTI EMESSI DD/MM/YYYY")

    

    If VBA.IsDate(dt1) And VBA.IsDate(dt2) Then

        

        If ActiveSheet.AutoFilterMode Then

            If ActiveSheet.FilterMode Then

                ActiveSheet.ShowAllData

            End If

        End If

    ActiveSheet.Range("A:Z").AutoFilter Field:=13, Criteria1:=">=" & Format(dt1, "mm/dd/yy"), Operator:= _

        xlAnd, Criteria2:="<=" & Format(dt2, "mm/dd/yy")

ThisWorkbook.Sheets("Componenti_Anelli").Range("C:C,D:D,L:L,M:M").Select

    Range("M1").Activate

    Selection.Copy

    Sheets("PROGETTI_EMESSI").Select

    Range("A1").Activate

    ActiveSheet.Paste

    Application.CutCopyMode = False

    ActiveSheet.Range("$A$1:$D$1028705").RemoveDuplicates Columns:=Array(1, 2, 3, 4) _

        , Header:=xlYes

    Range("A1").Select

    Sheets("Componenti_Anelli").Select

        If ActiveSheet.AutoFilterMode Then

            If ActiveSheet.FilterMode Then

                ActiveSheet.ShowAllData

            End If

        End If

    Range("A1").Select

     ActiveSheet.Range("A:Z").AutoFilter Field:=14, Criteria1:=">=" & Format(dt1, "mm/dd/yy"), Operator:= _

        xlAnd, Criteria2:="<=" & Format(dt2, "mm/dd/yy")

  ThisWorkbook.Sheets("Componenti_Anelli").Range("C:C,D:D,L:L,N:N").Select

    Range("N1").Activate

    Selection.Copy

    Sheets("ANELLI_POC_OA").Select

    Range("A1").Activate

    ActiveSheet.Paste

    Application.CutCopyMode = False

    ActiveSheet.Range("$A$1:$D$1028705").RemoveDuplicates Columns:=Array(1, 2, 3, 4) _

        , Header:=xlYes

    Range("A1").Select

    

    Else

        MsgBox ("FORMATO NON CORRETTO")

        GoTo RIAVVIO:

    End If 

   

End Sub

Senza un file di esempio, non ho tentato di seguire troppo da vicino le varie attività eseguite dal codice e non ho cercato di riprodurre il tuo file.

Detto questo suggerirei che, solitamente sia consigliabile evitare la selezione di fogli, intervalli o altri oggetti di Excel in quanto è raramente necessario e solitamente molto inefficiente.

Quindi, non testato da me e a titolo di esempio di approcchio, prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub NEW_PROGETTI_ANELLI()

    Dim WB As Workbook

    Dim SrcSH As Worksheet, destSH As Worksheet, destSH2 As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim Res1 As Variant, Res2 As Variant

    Const sFoglioDati As String = "Componenti_Anelli"

    Const sFoglioDestinazione As String = "PROGETTI_EMESSI"

    Const sFoglioDestinazione2 As String = "ANELLI_POC_OA"

    Const sMsg As String = "ISERISICI DATA "

    Const sMsg2 As String = "PER I NUOVI PROGETTI" _

              & "EMESSI DD/MM/YYYY"

    Const sColonneSorgente As String = "A:Z"

    Set WB = ThisWorkbook

    With WB

        Set SrcSH = .Sheets(sFoglioDati)

        Set destSH = .Sheets(sFoglioDestinazione)

        Set destSH2 = .Sheets(sFoglioDestinazione2)

    End With

    Set srcRng = SrcSH.Range(sColonneSorgente)

    Do Until IsDate(Res1)

        Res1 = InputBox(sMsg & " INIZIALE " & sMsg2)

        If StrPtr(Res1) = 0 Then

            Call MsgBox( _

                 Prompt:="Hai cancellato - Riprova!", _

                 Buttons:=vbCritical, _

                 Title:="REPORT")

            Exit Sub

        ElseIf Not IsDate(Res1) Then

            Call DataIncorretta

        End If

    Loop

    Do Until IsDate(Res2)

        Res2 = InputBox(sMsg & " FINALE " & sMsg2)

        If StrPtr(Res1) = 0 Then

            MsgBox "Hai cancellato!"

            Exit Sub

        ElseIf Not IsDate(Res1) Then

            Call DataIncorretta

        End If

    Loop

    With SrcSH

        If .AutoFilterMode Then

            If .FilterMode Then

                .ShowAllData

            End If

        End If

        srcRng.Cells(1).AutoFilter _

                Field:=13, _

                Criteria1:=">=" & Format(Res1, "mm/dd/yy"), _

                Operator:=xlAnd, _

                Criteria2:="<=" & Format(Res2, "mm/dd/yy")

        .Range("M1").Copy Destination:=destSH.Range("A1")

        destSH.Range("$A$1:$D$1028705").RemoveDuplicates _

                Columns:=Array(1, 2, 3, 4), _

                Header:=xlYes

        If .AutoFilterMode Then

            If .FilterMode Then

                .ShowAllData

            End If

        End If

        srcRng.Cells(1).AutoFilter Field:=14, _

                                   Criteria1:=">=" _

                                              & Format(Res1, "mm/dd/yy"), _

                                   Operator:=xlAnd, _

                                   Criteria2:="<=" & Format(Res2, "mm/dd/yy")

        .Range("N1").Copy Destination:=destSH2.Range("A1")

        destSH2.Range("$A$1:$D$1028705").RemoveDuplicates _

                Columns:=Array(1, 2, 3, 4), _

                Header:=xlYes

    End With

End Sub

'--------->>

Public Sub DataIncorretta()

    Const sMsg As String = "FORMATO NON CORRETTO"

    Call MsgBox( _

         Prompt:=sMsg, _

         Buttons:=vbInformation, _

         Title:="AVVISO")

End Sub

'<<=========

===

Regards,

Norman

Answer 3

Ciao Norman,

ti ringrazio anticipatamente per il tuo supporto, ma io non posso inserire il modulo nell'altro file.

Io dovrei copiare i dati presenti nel file x dello sheet Componenti_Anelli ed incollare la seleziona multipla nel file y sheet PROGETTI_EMESSI.

attendo tua 

ciao

Vito

Answer 4

Ciao Vito,

cambiato il codice come da te descritto non si presenta più l'errore

ma se dovessi fare la stessa operazione non sullo stesso file ma su un' altro file excel ,come dovrei fare?

attendo un tuo suggerimento

Basta incollare il codice suggerito in un modulo standard dell'altro file e modificare i valori assegnati alle costanti elencate alla testa del mio codice:

    Const sFoglioDati As String = "Componenti_Anelli"

    Const sFoglioDestinazione As String = "PROGETTI_EMESSI"

    Const sFoglioDestinazione2 As String = "ANELLI_POC_OA"

    Const sMsg As String = "ISERISICI DATA "

    Const sMsg2 As String = "PER I NUOVI PROGETTI" _

              & "EMESSI DD/MM/YYYY"

    Const sColonneSorgente As String = "A:Z"

Per chiudere questo thread, vorrei chiederti gentilmente di contrassegnare la mia risposta come Risposta preferita. In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

   

===

Regards,

Norman

Answer 5

Ciao Norman,

cambiato il codice come da te descritto non si presenta più l'errore

ma se dovessi fare la stessa operazione non sullo stesso file ma su un' altro file excel ,come dovrei fare?

attendo un tuo suggerimento

ciao

Vito