Evitar duplicados al copiar datos de una tabla dinámica a una hoja mediante los filtros en excel
Estoy construyendo una macro que me permita copiar los datos de la tabla de manera agrupada dependiendo su tipo de filtrado, he conseguido copiar cada uno pero en caso de que un filtrado no se encuentre me duplica la información de otro. Me ayudan por favor anexo código.
Dim i As Worksheet
Dim r As Worksheet
Dim pt As PivotTable
Dim rng As Range
Dim L As Long
Dim m As Long
Dim N As Long
Dim O As Long
Dim P As Long
Dim primera As Integer
Dim segunda As Integer
Dim tercera As Integer
Dim CUARTA As Integer
Dim QUINTA As Integer
Dim SEXTA As Integer
Dim SEPTIMA As Integer
Set i = Worksheets("Ordenar")
Set r = Worksheets("Formato General")
Set pt = i.PivotTables("Pivottable1")
Set rng = pt.TableRange1
Set rng2 = pt.PageRange
i.PivotTables("PivotTable1").PivotFields("AREA").CurrentPage = _
"HOSPITALIZACION"
primera = rng.Rows(1).Row
rng.Offset(1, 0).Copy Destination:=r.Cells(primera, 1)
If Not r Is Nothing Then
segunda = rng2.Rows(1).Row
rng2.Copy Destination:=r.Cells(segunda, 1)
End If
Application.CutCopyMode = False
i.PivotTables("PivotTable1").PivotFields("AREA").CurrentPage = _
"Insumos"
L = r.Range("a" & Rows.Count).End(xlUp).Row + 2
rng.Offset(1, 0).Copy Destination:=r.Cells(L, 1)
If Not r Is Nothing Then
tercera = L - 1
rng2.Copy Destination:=r.Cells(tercera, 1)
End If
Application.CutCopyMode = False
i.PivotTables("PivotTable1").PivotFields("AREA").CurrentPage = _
"LABORATORIO"
m = r.Range("a" & Rows.Count).End(xlUp).Row + 2
rng.Offset(1, 0).Copy Destination:=r.Cells(m, 1)
If Not r Is Nothing Then
CUARTA = m - 1
rng2.Copy Destination:=r.Cells(CUARTA, 1)
End If
Application.CutCopyMode = False
i.PivotTables("PivotTable1").PivotFields("AREA").CurrentPage = _
"QUIROFANO"
N = r.Range("a" & Rows.Count).End(xlUp).Row + 2
rng.Offset(1, 0).Copy Destination:=r.Cells(N, 1)
If Not r Is Nothing Then
QUINTA = N - 1
rng2.Copy Destination:=r.Cells(QUINTA, 1)
End If
Application.CutCopyMode = False
i.PivotTables("PivotTable1").PivotFields("AREA").CurrentPage = _
"MEDICAMENTOS"
O = r.Range("a" & Rows.Count).End(xlUp).Row + 2
rng.Offset(1, 0).Copy Destination:=r.Cells(O, 1)
If Not r Is Nothing Then
SEXTA = O - 1
rng2.Copy Destination:=r.Cells(SEXTA, 1)
End If
Application.CutCopyMode = False
i.PivotTables("PivotTable1").PivotFields("AREA").CurrentPage = _
"INHALOTERAPIA"
P = r.Range("a" & Rows.Count).End(xlUp).Row + 2
rng.Offset(1, 0).Copy Destination:=r.Cells(P, 1)
If Not r Is Nothing Then
SEPTIMA = P - 1
rng2.Copy Destination:=r.Cells(SEPTIMA, 1)
End If