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

1 respuesta

Respuesta
1

Para saber qué estás copiando y en dónde pegas, necesito hacer pruebas.


Te ayudo a simplificar la macro y a resolver el problema que tienes, pero necesito hacer pruebas con tu archivo.

Sube tu archivo en google drive, comparte el archivo para "Cualquier usuario de Internet que tenga el vínculo puede ver los elementos".

Copia el vínculo y lo pegas aquí.


IMPORTANTE: Si tienes información confidencial remplázala por datos genéricos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas