Macro en vb de Excel- si el rango está vacío me copia

Hice una macro en el excel (soy muy principiante), la macro consiste en que me filtre por unos valores predefinidos en la tabla, pudiendo estar esos valores o no, para después pegarlo en otra tabla de otra hoja.

Me hace los filtros correctos y me los pega bien cuando está el valor, pero en el momento que ese valor no existe en la tabla, me pega lo anterior a la celda que dije que me pagase si había valor. Cuando son tres o cuatro valores me funciona, pero si pongo más deja de funcionar. Esté sería el código

Sub Copiado_pegado()
Dim rng As Range
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=4, Criteria1:= _
"5501"
'oculto columnas
'Hoja1.ListObjects("Tabla111").ListColumns(2, 3, 4).DataBodyRange.Select

' descombino las celdas del titulo
Range("C9:M9").UnMerge

'oculto las dos columnas que no tengo que trasladar
Range("D:E").Select
Selection.EntireColumn.Hidden = True
' copiado y pegado 5501

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada 5501"
Else
Sheets("Hoja2").Select

rng.Copy Destination:=Range("B54")
End If

Application.CutCopyMode = False

'copiado y pegado a la 5502
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=4, Criteria1:= _
"5502"

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada 5502"
Else
Sheets("Hoja2").Select

rng.Copy Destination:=Range("B159")
End If
Application.CutCopyMode = False

'copiado y pegado a la 5503
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=4, Criteria1:= _
"5503"

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada 5503"
Else
Sheets("Hoja2").Select
rng.Copy Destination:=Range("B264")
Application.CutCopyMode = False
End If

'copiado y pegado a la 5506
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=4, Criteria1:= _
"5506"

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada 5506"
Else
Sheets("Hoja2").Select
rng.Copy Destination:=Range("B369")
Application.CutCopyMode = False
End If

'copiado y pegado a la 5507
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=4, Criteria1:= _
"5507"

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada"
Else
Sheets("Hoja2").Select

rng.Copy Destination:=Range("B474")
End If
Application.CutCopyMode = False

'copiado y pegado a la 5508
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=3, Criteria1:= _
"5508"

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada"
Else
Sheets("Hoja2").Select

rng.Copy Destination:=Range("B580")
End If
Application.CutCopyMode = False

'copiado y pegado a la 5514
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=3, Criteria1:= _
"5514"

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada"
Else
Sheets("Hoja2").Select

rng.Copy Destination:=Range("B685")
End If
Application.CutCopyMode = False

'copiado y pegado a la 5517
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=3, Criteria1:= _
"5517"

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada"
Else
Sheets("Hoja2").Select

rng.Copy Destination:=Range("B790")
End If
Application.CutCopyMode = False

'copiado y pegado a la 5519
Sheets("Pagare Exportar").Select
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=3, Criteria1:= _
"5519"

With ActiveSheet.ListObjects("Tabla111").DataBodyRange
On Error Resume Next
Set rng = .Resize(.Rows.Count, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

If rng Is Nothing Then
MsgBox "No hay nada"
Else
Sheets("Hoja2").Select

rng.Copy Destination:=Range("B960")
End If
Application.CutCopyMode = False

Sheets("Pagare Exportar").Select
'muestro columna oculta
Columns("D:E").Select
Selection.EntireColumn.Hidden = False
ActiveSheet.ListObjects("Tabla111").Range.AutoFilter Field:=3
'combinar celdas y centrar
'combino las celdas del titulo
Range("C9:M9").Merge
'centro
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
End Sub

Seguro que el código puede ser más corto e incluso esté mal algo, pero soy muy principiante y estoy empezando ¿Me podría ayudar alguien