Código: Selecionar todos
Public Sub Apply_Rating()
Dim arrShtNFe As Variant
Dim endCell As Long
Dim i As Long
Dim arrDisc As Variant
Dim Dict As New Scripting.Dictionary
Dim arrDef As Variant
Dim rng As Range
Dim tblDefault As ListObject
Dim efinal As Long
Set tblDefault = ShtDefault.ListObjects("Default")
With ShtNFe
ShtNFe.Activate
'METODO RANGE FALHA QUANDO A PLANILHA 'NFe' NÃO ESTÁ ATIVA
endCell = .Cells(.rows.count, 1).End(xlUp).row
arrShtNFe = .Range(.Cells(2, 1), Cells(endCell, 52))
For i = LBound(arrShtNFe) To UBound(arrShtNFe)
'arrShtNFe(i, 52) = DictProcessing(CStr(arrShtNFe(i, 14)))(4)
If DictProcessing.Exists(CStr(arrShtNFe(i, 14))) Then
arrShtNFe(i, 52) = DictProcessing(CStr(arrShtNFe(i, 14)))(4)
Dict(i) = arrShtNFe(i, 52)
End If
If i >= UBound(arrShtNFe) Then
arrDisc = Dict.Items
ShtNFe.ListObjects("NFe").ListColumns(52).DataBodyRange.value = Application.transpose(arrDisc)
Dict.RemoveAll
endCell = 0
End If
Next i
End With
ShtDefault.Activate
arrDef = DictNewItemDefault.Items
tblDefault.ListRows.Add alwaysinsert:=True
efinal = tblDefault.DataBodyRange.End(xlDown).Offset(1).row
tblDefault.Range.Offset(tblDefault.Range.rows.count).rows.Resize(DictProcessing.count, 4).value = arrDef
'DETALHE: Preciso que o objeto que receba os dados do array seja uma tabela, pois essa tabela será
'manipulada no power pivot na sequência.
End Sub
Espero ter ser sucinto nos objetivos; sei que é um pouco complicado sugerir algo sem debugar o código, porém na real o problema se resumo a "Redimensionar Tabela apartir da Última linha com dados" para receber conteúdo de array.
Desde já agradeço a interação.