Excel - Crear un archivo partiendo de otro archivo pero con condicion

Option Explicit

'//By JuanC - Mar. 2016

Sub ula_ula()

Dim rngPivot As Range, rngDst As Range

Dim lFil&, lRow&, k%, j%, i%, v As Variant

Dim wbkDst As Workbook, wsSrc As Worksheet

Set wsSrc = ThisWorkbook.Sheets("1")

Set wbkDst = Excel.Workbooks.Add

Set rngDst = wbkDst.Sheets(1).Range("A1")

v = Array("C53", "C82")

lRow = 0

For k = 0 To UBound(v)

    lFil = 0

    Set rngPivot = wsSrc.Range(v(k))

    Do While VBA.Trim(rngPivot.Offset(lFil, 0).Value) <> ""

       With rngDst

            .Offset(lRow, 0).Value = rngPivot.Offset(lFil, 0).Value

            .Offset(lRow, 1).Value = rngPivot.Offset(lFil, 1).Value

            i = 2

            For j = 4 To 8

                .Offset(lRow, i).Value = rngPivot.Offset(lFil, j).Value

                i = i + 1

            Next

       End With

       lRow = lRow + 1

       lFil = lFil + 1

    Loop

Next

wbkDst.SaveAs "datos.xlsx"

wbkDst.Close False

End Sub

Dim Activa As Worksheet

Dim Fila As Long, x As Long

Sub CopiarRangos()

Set Activa = ActiveSheet

Workbooks.Add

x = 52: ComúnCopiarRangos

x = 82: ComúnCopiarRangos

x = 111: ComúnCopiarRangos

x = 140: ComúnCopiarRangos

x = 169: ComúnCopiarRangos

Cells.EntireColumn.AutoFit

Application.Dialogs(xlDialogSaveAs).Show

End Sub

Private Sub ComúnCopiarRangos()

Do Until Trim(Activa.Range("C" & x)) = Empty

   Fila = Fila + 1

   Range("A" & Fila) = Activa.Range("C" & x)

   Range("B" & Fila) = Activa.Range("D" & x)

   Range("C" & Fila) = Activa.Range("G" & x)

   Range("D" & Fila) = Activa.Range("H" & x)

   Range("E" & Fila) = Activa.Range("I" & x)

   Range("F" & Fila) = Activa.Range("K" & x)

   Range("G" & Fila) = Activa.Range("AI" & x)

   x = x + 1

Loop

End Sub