Copiar/pegar función de lista desplegable

Sub Macro1()
Dim CS As Workbook 'declara la variable CS (Libro Fuente)
Dim MR As String 'declara la variable MR (Mes Buscado)
Dim SF As Object 'declara la variable SF (Sistema de Archivos)
Dim DT As Object 'declara la variable DT (Carpeta de Trabajo)
Dim FS As Object 'declara la variable FS (Archivos)
Dim F As Object 'declara la variable F (Archivo)
Dim CD As Workbook 'declara la variable CD (Libro Destino)
Dim O1 As Object 'declara la variable O1 (Hoja 1)
Dim O2 As Object 'declara la variable O2 (Hoja 2)
Dim R As Range 'declara la variable R (Búsqueda)
Dim CP As Byte 'declara la variable CP (Columna Promo)
Dim CNP As Byte 'declara la variable CNP (Columna No Promo)

Application.ScreenUpdating = False 'oculta las actualizaciones de pantalla
Set CS = ThisWorkbook 'define el libro fuente CS
MR = CS.Sheets("Lista Desplegable").Range("D4").Value 'define el mes buscado
Set SF = CreateObject("Scripting.Filesystemobject") 'define el sistema de archivos SF
Set DT = SF.GetFolder(ThisWorkbook.Path) 'define la carpeta de trabajo DT
Set FS = DT.Files 'define el conjunto de archivos FS contenidos en la carpeta de trabajo
For Each F In FS 'bucle sobre todos los archivos F del conjunto FS
 If Right(F.Name, 5) = ".xlsx" Then 'condición 1: si la extensión del archivo es ".xlsx"
 On Error Resume Next 'gestión de errores (en caso de error pasa a la línea siguiente)
 Set CD = Workbooks(F.Name) 'define el libro destino CD (genera un error si este libro no está abierto)
 If Err <> 0 Then 'condición 2: si se ha generado un error
 Err.Clear 'borra el error
 Workbooks.Open (F) 'abre el archivo F
 Set CD = ActiveWorkbook 'define el libro destino CD
 End If 'fin de la condición 2
 Set O1 = CD.Sheets("Vol Prev") 'define la hoja O1 (genera un error si esta hoja no existe)
 If Err <> 0 Then 'condición 3: si se ha generado un error
 Err.Clear 'borra el error
 CD.Close 'cierra el libro CD
 GoTo suite 'va a la etiqueta "suite"
 End If 'fin de la condición 3
 On Error GoTo 0 'anula la gestión de errores
 Set O2 = CD.Sheets("Actualizar Vol") 'define la hoja O2
 Set R = O1.Rows(5).Find(MR, , xlValues, xlWhole) 'define la búsqueda R
 If Not R Is Nothing Then 'condición 4: si existe al menos una ocurrencia encontrada
 CNP = R.Column 'define la columna no promo CNP
 CP = R.Column + 1 'define la columna promo CP
 Else 'de lo contrario
 MsgBox "¡Mes no encontrado!": Exit Sub 'mensaje, sale del procedimiento
 End If 'fin de la condición 4
 O1.Range(O1.Cells(8, CP), O1.Cells(18, CP)).Copy 'copia los valores de la columna promo del mes buscado en la hoja O1
 O2.Range("C8").PasteSpecial (xlPasteValues) 'pega los valores en la celda C8 de la hoja O2
 O2.Range("B8:B18").Copy 'copia los datos calculados del rango B8:B18 de la hoja O2
 O1.Cells(8, CNP).PasteSpecial (xlPasteValues) 'pega los valores en la fila 8 de la columna no promo del mes buscado
 Application.CutCopyMode = False 'elimina el parpadeo de las celdas relacionado con "copiar"
 CD.Close SaveChanges:=True 'cierra el libro destino guardando los cambios
 End If 'fin de la condición 1
suite: 'etiqueta
Next F 'siguiente archivo del conjunto de archivos FS
Application.ScreenUpdating = True 'muestra las actualizaciones de pantalla
End Sub

Sub Macro1()

Dim CS As Workbook 'declara la variable CS (Libro Fuente)
Dim MR As String 'declara la variable MR (Mes Buscado)
Dim SF As Object 'declara la variable SF (Sistema de Archivos)
Dim DT As Object 'declara la variable DT (Carpeta de Trabajo)
Dim FS As Object 'declara la variable FS (Archivos)
Dim F As Object 'declara la variable F (Archivo)
Dim CD As Workbook 'declara la variable CD (Libro Destino)
Dim O1 As Object 'declara la variable O1 (Hoja 1)
Dim O2 As Object 'declara la variable O2 (Hoja 2)
Dim R1 As Range 'declara la variable R1 (Búsqueda 1)
Dim R2 As Range 'declara la variable R2 (Búsqueda 2)
Dim CP As Byte 'declara la variable CP (Columna Promo)
Dim CNP As Byte 'declara la variable CNP (Columna No Promo)

Application.ScreenUpdating = False 'oculta las actualizaciones de pantalla
Set CS = ThisWorkbook 'define el libro fuente CS
Set O1 = CS.Sheets("Vol No Promo") 'define la hoja O1
Set R1 = O1.Rows(4).Find(MR, , xlValues, xlWhole) 'define la búsqueda R1
If Not R1 Is Nothing Then 'condición A : si existe al menos una ocurrencia encontrada
 CNP = R1.Column 'define la columna no promo CNP
 Else 'sino
 MsgBox "¡Mes no encontrado!": Exit Sub 'mensaje, sale del procedimiento
End If 'fin de la condición A
MR = CS.Sheets("Macro").Range("G10").Value 'define el mes buscado
Set SF = CreateObject("Scripting.Filesystemobject") 'define el sistema de archivos SF
Set DT = SF.GetFolder(ThisWorkbook.Path) 'define la carpeta de trabajo DT
Set FS = DT.Files 'define el conjunto de archivos FS contenidos en la carpeta de trabajo
For Each F In FS 'bucle sobre todos los archivos F del conjunto FS
 If Right(F.Name, 5) = ".xlsm" Then 'condición 1 : si la extensión del archivo es ".xlsm"
 On Error Resume Next 'gestión de errores (en caso de error pasa a la siguiente línea)
 Set CD = Workbooks(F.Name) 'define el libro destino CD (genera un error si este libro no está abierto)
 If Err <> 0 Then 'condición 2 : si se ha generado un error
 Err.Clear 'limpia el error
 Workbooks.Open (F) 'abre el archivo F
 Set CD = ActiveWorkbook 'define el libro destino CD
 End If 'fin de la condición 2
 Set O2 = CD.Sheets("Vol_SKU_COLS_SAISI") 'define la hoja O2 (genera un error si esta hoja no existe)
 Set R2 = O2.Rows(4).Find(MR, , xlValues, xlWhole) 'Define la búsqueda en la hoja 02
 If Not R2 Is Nothing Then 'condición B : si existe al menos una ocurrencia encontrada
 CNP = R2.Column 'define la columna no promo CNP
 CP = R2.Column + 1 'define la columna promo CP
 If Err <> 0 Then 'condición 3 : si se ha generado un error
 Err.Clear 'limpia el error
 CD.Close 'cierra el libro CD
 GoTo suite 'va a la etiqueta "suite"
 End If 'fin de la condición 3
 On Error GoTo 0 'anula la gestión de errores
 O1.Range(O1.Cells(7, CNP), O1.Cells(86, CNP)).Copy 'copia los valores de la columna no promo del mes buscado en la hoja O1
 O2.Range(O2.Cells(7, CNP), O2.Cells(86, CNP)).PasteSpecial (xlPasteValues) 'pega los valores en la columna CNP de la hoja 02
 Application.CutCopyMode = False 'elimina el parpadeo de las celdas relacionado con el "copiar"
 CD.Close SaveChanges:=True 'cierra el libro destino guardando los cambios
 End If 'fin de la condición 1
suite: 'etiqueta
Next F 'próximo archivo del conjunto de archivos FS
Application.ScreenUpdating = True 'muestra las actualizaciones de pantalla
End Sub

Next F 'próximo archivo del conjunto de archivos FS