copiar y pegar a otra hoja

[idaira]

*Hola chicos,a ver si me podeis ayudar a realizar una macro para copiar los datos de una hoja llamada diario a la otra llamada mayor.

se como es el codigo de una macro para seleccionar y copiar pero el problema es que es con rangos variables pues en el boton que existe en la hoja diario añade nuevas filas para nuevos asientos y ahora mismo no se me ocurre como hacer lo mencionado en el punto anterior.

otra cosa las columnas a copiar seria la del nº de asientos,subcuenta,concepto,debe y haber a ser posible.

adjunto el archivo que seguro lo entenderan mejor.

muchas gracias y perdonen las molestias;)

plantilla contabilidad.zip

[idaira]

Hola a todos,en lo que alguien me responde me he puesto a indagar por aqui y he adaptado un codigo vba a mi plantilla,pero se me queda en bucle infinito,me puede alguien ayudar?

Dim H1 As String: H1 = "Diario"

Dim H2 As String: H2 = "Mayor"

Dim Status As String: Status = ""

Dim H2LastRow As Double: H2LastRow = 1

Do While Sheets("" & H2 & "").Cells(H2LastRow, 1) <> "": H2LastRow = H2LastRow + 1: Loop

Sheets("" & H1 & "").Select

With Sheets("" & H1 & "")

.Unprotect

For i = 3 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

RepetirFila:

If .Cells(i, 2) <> Status Then

'aqui intento copiar de la hoja "diario", lo que contiene la primera celda de las columnas b,f,g,h,e i para luego copiarlas en la hoja "mayor" a partir de la fila a3 y asi sucesivamente para copiar todos los datos de la hoja "diario"

.Range("B" & i & ":F" & i & ":G" & i & ":H" & i & ":I" & i & "").Copy

Sheets("" & H2 & "").Select

Sheets("" & H2 & "").Cells(H2LastRow, 1).Select

ActiveSheet.Paste

H2LastRow = H2LastRow + 1

.Select

.Rows("" & i & "").Select

GoTo RepetirFila

End If

Next i

.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("" & H2 & "").Select

Cells.Select

Selection.Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

.Select

.Cells(1, 1).Select

End With

[idaira]

Vaya, nadie me puede ayudar ?

[Antoni]

Prueba con esta macro

Sub CopiarDeDiarioAMayor()


   Dim Diario As Worksheet, FilaDiario As Long

   Dim Mayor As Worksheet, FilaMayor As Long


   Set Diario = Sheets("Diario")

   Set Mayor = Sheets("Mayor")


   FilaDiario = Diario.Range("B" & Rows.Count).End(xlUp).Row

   FilaMayor = Mayor.Range("A" & Rows.Count).End(xlUp).Row


   Mayor.Unprotect

   For x = 2 To FilaDiario

      FilaMayor = FilaMayor + 1

      Mayor.Range("A" & FilaMayor).Value = Diario.Range("B" & x).Value

      Mayor.Range("B" & FilaMayor).Value = Diario.Range("F" & x).Value

      Mayor.Range("C" & FilaMayor).Value = Diario.Range("G" & x).Value

      Mayor.Range("D" & FilaMayor).Value = Diario.Range("H" & x).Value

      Mayor.Range("E" & FilaMayor).Value = Diario.Range("I" & x).Value

   Next


   Mayor.Range("A3:E" & FilaMayor).SortSpecial Key1:=Mayor.Range("A3")

   Mayor.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True


End Sub

[/CODE]

saludos, y hay que tener un poco de paciencia, que hay mucha gente de vacaciones.