Copiar una columna excel a otro libro

Ejecuta la siguiente macro.

Actualiza en la macro estos datos:

  Set s1 = w1.Sheets("Resumen")   'Hoja Resumen
  ruta = "C:\trabajo\"            'carpeta donde tienes los libros con datos
  sName = "Hoja1"                 'Hoja de libros de datos

Pon la macro en tu libro resumen, guarda el libro como libro de excel habilitado para macros y pon el libro en una carpeta diferente a la carpeta donde tienes los libros con datos:

Sub Copiar_Columnas()
  Dim ruta As String, arch As String, sName As String
  Dim w1 As Workbook, w2 As Workbook
  Dim s1 As Worksheet, s2 As Worksheet
  Dim j As Long
  '
  Application.ScreenUpdating = False
  Set w1 = ThisWorkbook
  Set s1 = w1.Sheets("Resumen")   'Hoja Resumen
  ruta = "C:\trabajo\"            'carpeta donde tienes los libros con datos
  sName = "Hoja1"                 'Hoja de libros de datos
  '
  s1.Cells.Clear
  arch = Dir(ruta & "*.xls*")
  Do While arch <> ""
    Set w2 = Workbooks.Open(ruta & arch)
    If Evaluate("ISREF('" & sName & "'!A1)") Then
      Set s2 = w2.Sheets(sName)
      j = j + 1
      s2.Range("D:D").Copy s1.Cells(1, j)
    End If
    w2.Close False
    arch = Dir()
  Loop
  '
  Application.ScreenUpdating = True
  MsgBox "Fin", vbInformation, "Copiar Columnas a libro resumen"
End Sub

Lo primero muchas gracias por tu rápida contestación, me pongo a probarla y te cuento el resultado.

La parte que dices actualiza en la macro estos datos:

  Set s1 = w1.Sheets("Resumen")   'Hoja Resumen
  ruta = "C:\trabajo\"            'carpeta donde tienes los libros con datos
  sName = "Hoja1"                 'Hoja de libros de datos

Esta parte, ¿la pongo dentro de la macro "Sub Copiar_Columnas()"?

Gracias un saludo

Por supuesto, debes poner tus datos dentro de la macro, ya actualizada la macro la ejecutas.

Buenas tardes, ejecuto la macro actualizándola como me dijiste y me da error

"Se ha producido el error "9" en tiempo de ejecución:

Subíndice fuera del intervalo"

En cuál línea se detiene la macro

¿Cómo se llama tu hoja "resumen" en tu libro "resumen"?

"hoja1" igual que en los anteriores,

Ya corregí ese error, renombre bien dentro de la macro la "hoja1" del libro resumen. Ahora ejecuto la macro y me aparece el "msgbox"= FIN pero no me copia nada en mi documento resumen.

Ayúdame a ayudarte

Dame todos los datos completos.

Sobre el libro RESUMEN.

Cómo se llama el libro resumen.

Cómo se llama la hoja que está en el libro resumen.

Cómo se llama la carpeta donde está el libro resumen.

Sobre los libros con datos.

Cómo se llama la hoja que está en los libros con datos.

Cómo se llama la carpeta donde están los libros con datos.

Responde en ese orden.

Sobre el libro RESUMEN.

Cómo se llama el libro resumen. = ENERO

Cómo se llama la hoja que está en el libro resumen.= Hoja1

Cómo se llama la carpeta donde está el libro resumen.= AÑO 2020

Sobre los libros con datos.

Cómo se llama la hoja que está en los libros con datos.= Hoja1

Cómo se llama la carpeta donde están los libros con datos.= 01.ENERO

Responde en ese orden.

Puedes poner los datos COMPLETOS

Cómo se llama la carpeta donde están los libros con datos.= 01. ENERO

Pon el nombre de la carpeta completo

"C:\...\...\" etc

Necesito los datos completos.

Disculpa

D:\cos\servicio 2020\año 2020\01.ENERO

Prueba lo siguiente:

Sub Copiar_Columnas()
  Dim ruta As String, arch As String, sName As String
  Dim w1 As Workbook, w2 As Workbook
  Dim s1 As Worksheet, s2 As Worksheet
  Dim j As Long
  '
  Application.ScreenUpdating = False
  Set w1 = ThisWorkbook
  Set s1 = w1.Sheets("Hoja1")
  ruta = "D:\cos\servicio 2020\año 2020\01.ENERO\"
  sName = "Hoja1"                 'Hoja de libros de datos
  '
  s1.Cells.Clear
  On Error Resume Next
  If Dir(ruta, vbDirectory) = "" Then
    MsgBox "No existe la carpeta : " & ruta
    Exit Sub
  End If
  On Error GoTo 0
  '
  arch = Dir(ruta & "*.xls*")
  If arch = "" Then
    MsgBox "No existen archivos en la ruta"
    Exit Sub
  End If
  '
  Do While arch <> ""
    Set w2 = Workbooks.Open(ruta & arch)
    If Evaluate("ISREF('" & sName & "'!A1)") Then
      Set s2 = w2.Sheets(sName)
      j = j + 1
      s2.Range("D:D").Copy s1.Cells(1, j)
    End If
    w2.Close False
    arch = Dir()
  Loop
  '
  If j = 0 Then
    MsgBox "Ningún libro tiene una hoja llamada " & sName
    Exit Sub
  End If
  '
  Application.ScreenUpdating = True
  MsgBox "Fin", vbInformation, "Copiar Columnas a libro resumen"
End Sub

Hemos mejorado, me trae todos los datos de todas las columnas "D" de mis libros de datos.

El problema es que esa columna son números enteros pero el contenido de la celda es una fórmula de suma, y al copiarlos a mi nuevo libro resume no me copia el dato que había, dato numérico de la suma, si no que me ha copiado todas las fórmulas.

No se si me explico