Aggiungere riga per cancella elementi

[Ale.1989Partecipante Ale.1989]

Ciao a tutti vorrei aggiungere a questo codice una riga per far si che in caso il codice ricercato sia non sia presente nel database mi vengano cancellate alcune celle, al momento mi appare solo il messaggio

"Il codice cercato non esiste!"

Pensavo di aggiungere solo una riga Range (d44;ecc)clear.contents ma non funziona.... 

Non sono un esperto quindi non ho proprio idea di come si faccia.

P.s. le celle da cancellare sarebbero D44,G44,I44,J44  e l'intervallo G6:G16 del foglio "MASCHERA RICERCA"

Option Explicit

Sub RicercaCodice()
Dim wsMR As Worksheet, wsDt As Worksheet
Dim rngDt As Range, Trovato As Range
Dim urDt As Long
Dim Cerca As Variant, arr1 As Variant, arr2 As Variant
Dim i As Byte

Application.ScreenUpdating = False

Set wsMR = ThisWorkbook.Worksheets("MASCHERA RICERCA")
Set wsDt = ThisWorkbook.Worksheets("Database")

Cerca = wsMR.Range("K7")

If Cerca = "" Then
    MsgBox "Non hai indicato alcun codice da ricercare!", vbInformation, "Ricerca codice"
    Exit Sub
End If

urDt = wsDt.Cells(Rows.Count, 1).End(xlUp).Row

Set rngDt = wsDt.Range("A2:A" & urDt)

Set Trovato = rngDt.Find(Cerca, LookIn:=xlValues, LookAt:=xlWhole)
If Trovato Is Nothing Then
    MsgBox "Il codice cercato non esiste!", vbInformation, "Attenzione..."
    
Else
    'array del Foglio Database
    arr1 = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", _
                 "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AL", "AK", "AO", "AM", "AN", "AQ", "AR", _
                 "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "AP", "BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", _
                 "BK", "BL", "BM", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ", "CA", "CB", "CC", "CD", "CE", "CF", _
                 "CG", "CH", "CI", "CJ", "CK", "CL", "CM", "CN", "CO", "CP", "CQ", "CR", "CS", "CT", "CU", _
                 "CV", "CW", "CX", "CY", "CZ", "DA")
    
    'array del Foglio Maschera Ricerca
    arr2 = Array("K11", "K12", "K14", "K15", "K16", "K17", "K18", "K19", "K20", "K21", "K22", "K23", "K24", "K25", "K26", "K27", _
                 "K29", "K30", "K31", "K33", "K34", "L17", "L18", "L19", "L20", "L21", "L22", "L23", "M17", "M18", "M19", "M20", _
                 "M21", "M22", "M23", "G29", "G31", "H47", "H34", "H35", "G8", "G9", "D49", "N49", "G10", "G7", "G11", "G12", "G13", _
                 "G14", "K8", "F37", "G37", "H37", "X6", "X7", "X8", "K36", "M36", "H31", "G32", "U46", "T48", "U41", "G15", "G6", _
                 "N15", "N17", "N18", "N19", "N20", "N21", "N22", "N23", "O17", "O18", "O19", "O20", "O21", "O22", "O23", "P17", _
                 "P18", "P19", "P20", "P21", "P22", "P23", "G16", "G17", "G18", "G19", "H8", "H9", "X8", "X7", "X6", "D44", "G44", "I44", "J44")

    For i = LBound(arr1) To UBound(arr1)
        wsMR.Range(arr2(i)) = wsDt.Cells(Trovato.Row, arr1(i))
    Next i
    
End If

Set wsMR = Nothing: Set wsDt = Nothing: Set Trovato = Nothing

Application.ScreenUpdating = True

End Sub

Allego il codice funzionante

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ale.1989 ha scritto:

Pensavo di aggiungere solo una riga Range (d44;ecc)clear.contents ma non funziona.... 

 

Sì che funziona.
Solo che devi scriverla come si deve.

[Ale.1989Partecipante Ale.1989]

Fatto, ho trovato l'errore   

[Autore]

Articoli