Bom dia a todos,

Tenho um código que pega os dados da minha listbox e insere na minha planilha. O código também faz um filtro para verificar se existem valores repetidos e caso positivo, ele faz a consolidação desses dados, somando os valores e mantendo apenas uma versão.

O código está funcionando perfeitamente, porém ele começa a inserir os produtos a partir da linha A2 da minha planilha. Eu preciso ajustá-lo para que os dados sejam inseridos na planilha a partir da linha B14.

Parece algo simples, mas quando eu altero das referência na linha relacionada a CurrentRegion, eu acabo bagunçando o filtro.

Alguém poderia me ajudar? Quais alterações devo fazer? 

Abaixo está o código e em anexo a planilha.

Se alguém puder me ajudar, ficarei grato!

Private Sub btn_inserirpartida_Click()

Application.ScreenUpdating = False
Dim Rng As Range, RngList As Object, WS1 As Worksheet, WS2 As Worksheet, desWS As Worksheet, key As Variant, n, i As Integer
Dim ultimalinha As Long, fVisRow As Long, lVisRow As Long, ID As Range, totE As Double, totH As Double, rowCount As Long, x As Long
Set ws = ThisWorkbook.Sheets("Pedido")
ws.Activate


n = ws.Range("A1").CurrentRegion.Rows.Count + 1
i = ListBoxProdutos3.ListCount - 1

Range(ws.Cells(n, 1), Cells(n + i, 8)).Value = ListBoxProdutos3.List
ultimalinha = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set RngList = CreateObject("Scripting.Dictionary")
For Each Rng In Range("B2", Range("B" & Rows.Count).End(xlUp))
If Not RngList.Exists(Rng.Value) Then
RngList.Add Rng.Value, Nothing
End If
Next
For Each key In RngList
With ActiveSheet
.Cells(1, 2).CurrentRegion.AutoFilter 2, key
rowCount = .[subtotal(103,B:B)] - 1
If rowCount > 1 Then
fVisRow = .Range("A2:A" & ultimalinha).SpecialCells(xlCellTypeVisible).Cells(1, 2).Row
lVisRow = .Cells(Rows.Count, "A").End(xlUp).Row

For Each Rng In .Range("D" & fVisRow & ":D" & lVisRow).SpecialCells(xlCellTypeVisible)
totE = totE + Rng
totH = totH + Rng.Offset(, 2)
Next Rng
.Range("D" & fVisRow) = totE
.Range("G" & fVisRow) = totH
For x = ultimalinha To fVisRow + 1 Step -1
If .Rows(x).Hidden = False Then .Rows(x).Delete
Next x
End If
End With
totE = 0
totH = 0
Next key
Range("B1").AutoFilter

Unload Me
Application.ScreenUpdating = True
MsgBox "Registrado com Sucesso!"

End Sub