Macro en VBA Excel 2010 copiar en columnas consecutivas

Te propongo lo siguiente, en la hoja 2 en la celda H1 vamos a poner el número de vez, es decir, la primera vez será el 1, luego el 2, y así hasta llegar al 7, cuando llegue a 7, regresará a 1.

Prueba la siguiente macro:

Sub Copiar_Columna()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    If h2.Range("H1") = "" Or h2.Range("H1") = 0 Or h2.Range("H1") = 7 Then
        col = 1
        h2.Range("H1") = col
    Else
        col = h2.Range("H1")
        h2.Range("H1") = h2.Range("H1") + 1
        col = col + 1
    End If
    h1.Range("A1:A37").Copy h2.Cells(1, col)
    MsgBox "Columna copiada"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

¡Gracias! Antes de probarlo permítame agradecerle ya que es mi primera pregunta en este tipo de foros y la rapidez y claridad en la respuesta me parece impecable. Muchas gracias!

Dante, buen día! Estoy probando tu aporte y lo único que queda por resolver es que necesito que copie sólo Valores.

Seguro es sencillo de resolver pero soy muy novato en este asunto..

Gracias!

Esta macro te puede servir. Estoy asumiendo por tus comentarios que siempre se pegará en col A:G ... por lo que si supera la col 7 se limpiará el rango y volverá a pegar a partir de A:

Sub paseDatos()
'x Elsamatilde
'copiar rango de Hoja1 a Hoja2.
'verificar si ya se utilizó una columna, en ese caso se pega en la siguiente
'Se ejecuta desde la hoja1
Set ho2 = Sheets("Hoja2")
'se busca la col libre
If ho2.[A1] = "" Then
    colx = 1
Else
    colx = ho2.Range("H1").End(xlToLeft).Column + 1
End If
'si la última ocupada es la G se borran las col utilizadas para empezar nuevamente en A
If colx = 8 Then
    ho2.Columns("A:G").ClearContents   'evaluar si hay más datos en las col que no deben borrarse
    colx = 1
End If
'se copia rango de hoja1 a hoja2
[A1:A7].Copy Destination:=ho2.Cells(1, colx)
End Sub

Solo debes tener presente que estoy borrando las col A:G no solo el rango A1:G7... cualquier duda me consultas nuevamente.

Primero en el campo i1 debes poner la fecha inicial y en la j1 la siguiente fórmula j1=i1+7, solo para efectos de prueba resta 7 días a la fecha de hoy y esa fecha la pones en i1, esto solo lo haces una vez la macro se encargara en lo sucesivo de poner la fecha, luego copia la macro y la la colocas en el modulo thisworkbook y la macro copia compara la fecha cada que abras el libro con el dato de la celda j1 si es verdadero copiara el contenido de la hoja 1 a la hoja 2

f

Private Sub Workbook_Open()
fecha = Date
proximo = Worksheets("hoja1").Range("j1")
If proximo = fecha Then copiar
    Worksheets("hoja1").Range("a1").CurrentRegion.Copy
    Worksheets("hoja2").Range("a1").PasteSpecial
    MsgBox ("registros copiados")
    Worksheets("hoja1").Range("i1") = fecha
End If
End Sub