Copiar formato de filas.

maret · el 20 de mayo

Buenos días estimados, estoy lidiando con un tema que no encuentro ayuda en ningún lado.

El problema es así, en un libro de excel se le agregó dos filas con campos dinámicos de datos. Antes de que se le agreguen estos campos, el libro funcionaba bien, generaba una copia de una de las hojas en una hoja nueva y copiaba bien todo ahora no copia el alto de las filas, sale todo en tamaño normal.

La verdad que ya no se que hacer para resolver este problema.

El código que genera este informe es el siguiente:

Option Explicit

Sub genDefinitivo()

'

' Macro3 Macro

' Macro grabada el 28/10/2008 por dapezteguia

'

Dim tArchOrig As String, tArchDes As String, tArchDefinitivo As String

Application.SheetsInNewWorkbook = 2

VerArchDefinitivo

tArchDefinitivo = Range("AI101").Value

tArchOrig = ActiveWindow.Caption

Workbooks.Add

tArchDes = ActiveWindow.Caption

Windows(tArchOrig).Activate

Sheets("GRAL").Select

Cells.Select

Range("D1").Activate

Selection.Copy

Windows(tArchDes).Activate

Cells.Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=-6

Windows(tArchOrig).Activate

Range("E19:U37").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("E19:U37").Select

ActiveWindow.ScrollColumn = 4

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

ActiveWindow.ScrollColumn = 5

ActiveWindow.ScrollColumn = 6

ActiveWindow.ScrollColumn = 7

ActiveWindow.ScrollColumn = 6

ActiveWindow.ScrollColumn = 5

ActiveWindow.ScrollColumn = 4

Windows(tArchOrig).Activate

Range("E43:U43").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("E43").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Windows(tArchOrig).Activate

Range("T48").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("T48").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Windows(tArchOrig).Activate

Range("T50").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("T50").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Windows(tArchOrig).Activate

Range("F53:T57").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("F53").Select

' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

' :=False, Transpose:=False

Windows(tArchOrig).Activate

Range("O59").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("O59").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("D61").Select

ActiveWindow.SmallScroll Down:=12

Rows("75:75").Select

Range("D75").Activate

ActiveWindow.SmallScroll Down:=29

Range(Selection, Selection.End(xlDown)).Select

Rows("75:116").Select

Range("D75").Activate

Application.CutCopyMode = False

Selection.Delete Shift:=xlUp

Windows(tArchOrig).Activate

Sheets("PODER_RESCATE").Select

Cells.Select

Range("C1").Activate

Selection.Copy

Windows(tArchDes).Activate

Sheets("Hoja2").Select

Cells.Select

ActiveSheet.Paste

Windows(tArchOrig).Activate

Range("D14:L37").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("D14").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Rows("40:244").Select

Range("C40").Activate

Sheets("Hoja2").Select

Sheets("Hoja2").Name = "Poder rescate"

Sheets("Hoja1").Select

Sheets("Hoja1").Name = "GRAL"

Range("E56").Select

Windows(tArchDes).Activate

Sheets("Poder rescate").Select

'Se cambio el 60 por el 62: Limite de lineas

Range("C62:IV982").Select

Application.CutCopyMode = False

Selection.ClearContents

'Se cambio el 60 por el 62: Limite de lineas

Rows("62:502").Select

Range("C62").Activate

Selection.Delete Shift:=xlUp

Range("R1:IV982").Select

Application.CutCopyMode = False

Selection.ClearContents

Windows(tArchDes).Activate

Sheets("GRAL").Select

Range("D75:IV982").Select

Application.CutCopyMode = False

Selection.ClearContents

Range("AA:IV").Select

Application.CutCopyMode = False

Selection.ClearContents

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = Application.InchesToPoints(0)

.RightMargin = Application.InchesToPoints(0)

.TopMargin = Application.InchesToPoints(0)

.BottomMargin = Application.InchesToPoints(0)

.HeaderMargin = Application.InchesToPoints(0)

.FooterMargin = Application.InchesToPoints(0)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintNoComments

'.PrintQuality = 600

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperA4

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 1

End With

Windows(tArchDes).Activate

Sheets("Poder rescate").Select

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = Application.InchesToPoints(0)

.RightMargin = Application.InchesToPoints(0)

.TopMargin = Application.InchesToPoints(0)

.BottomMargin = Application.InchesToPoints(0)

.HeaderMargin = Application.InchesToPoints(0)

.FooterMargin = Application.InchesToPoints(0)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintNoComments

'.PrintQuality = 600

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperA4

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 1

End With

Range("C4").Activate

Sheets("GRAL").Select

Range("D12").Activate

'ChDir "\\Cpmtecnologia\Tecnologia\Desarrollo\CierreMesas\Arqueo\2008_08\Definitivos"

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:= _

tArchDefinitivo _

, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _

ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWindow.Close

Application.DisplayAlerts = True

Windows(tArchOrig).Activate

Sheets("PODER_RESCATE").Select

Range("D1").Activate

Sheets("GRAL").Select

Range("D1").Activate

End Sub

Sub genAdministracion()

'

' Macro3 Macro

' Macro grabada el 28/10/2008 por dapezteguia

'

Dim tArchOrig As String, tArchDes As String, tArchDefinitivo As String

Application.SheetsInNewWorkbook = 1

VerArchAdministracion

tArchDefinitivo = Range("AI101").Value

tArchOrig = ActiveWindow.Caption

Workbooks.Add

tArchDes = ActiveWindow.Caption

Windows(tArchOrig).Activate

Sheets("GRAL").Select

Cells.Select

Range("D1").Activate

Selection.Copy

Windows(tArchDes).Activate

Cells.Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=-6

Windows(tArchOrig).Activate

Range("E19:U37").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("E19:U37").Select

ActiveWindow.ScrollColumn = 4

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

ActiveWindow.ScrollColumn = 5

ActiveWindow.ScrollColumn = 6

ActiveWindow.ScrollColumn = 7

ActiveWindow.ScrollColumn = 6

ActiveWindow.ScrollColumn = 5

ActiveWindow.ScrollColumn = 4

Windows(tArchOrig).Activate

Range("S68:U68").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("S68").Select

ActiveWindow.ScrollColumn = 4

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Windows(tArchOrig).Activate

Range("E43:U43").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("E43").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Windows(tArchOrig).Activate

Range("T48").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("T48").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Windows(tArchOrig).Activate

Range("F52:O64").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("F52").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Windows(tArchOrig).Activate

Range("O57").Select

Application.CutCopyMode = False

Selection.Copy

Windows(tArchDes).Activate

Range("O57").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("D59").Select

ActiveWindow.SmallScroll Down:=12

Rows("73:73").Select

Range("D73").Activate

ActiveWindow.SmallScroll Down:=29

Range(Selection, Selection.End(xlDown)).Select

Rows("73:116").Select

Range("D73").Activate

Application.CutCopyMode = False

Selection.Delete Shift:=xlUp

Sheets("Hoja1").Select

Sheets("Hoja1").Name = "GRAL"

Range("E56").Select

Windows(tArchDes).Activate

Sheets("GRAL").Select

Range("D75:IV982").Select

Application.CutCopyMode = False

Selection.ClearContents

Range("AA:IV").Select

Application.CutCopyMode = False

Selection.ClearContents

Rows("19:35").Select

Range("D19").Activate

Selection.Delete Shift:=xlUp

Range("R33").Select

ActiveWindow.ScrollColumn = 5

ActiveWindow.ScrollColumn = 6

ActiveWindow.ScrollColumn = 7

Range("N33").Select

Selection.Copy

Range("R33:T33").Select

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Selection.ClearContents

Selection.ClearComments

' Windows(tArchOrig).Activate

' Range("R63:U74").Select

' Selection.Copy

' Windows(tArchDes).Activate

' Range("R46").Select

' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

' :=False, Transpose:=False

' Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _

' :=False, Transpose:=False

Windows(tArchOrig).Activate

Range("D46:AA46").Select

Selection.Copy

Windows(tArchDes).Activate

Range("D29").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = Application.InchesToPoints(0)

.RightMargin = Application.InchesToPoints(0)

.TopMargin = Application.InchesToPoints(0)

.BottomMargin = Application.InchesToPoints(0)

.HeaderMargin = Application.InchesToPoints(0)

.FooterMargin = Application.InchesToPoints(0)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintNoComments

' .PrintQuality = 600

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperA4

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 1

End With

Sheets("GRAL").Select

Range("D12").Activate

'ChDir "\\Cpmtecnologia\Tecnologia\Desarrollo\CierreMesas\Arqueo\2008_08\Definitivos"

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:= _

tArchDefinitivo _

, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _

ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWindow.Close

Application.DisplayAlerts = True

Windows(tArchOrig).Activate

Sheets("PODER_RESCATE").Select

Range("D1").Activate

Sheets("GRAL").Select

Range("D1").Activate

End Sub

Gracias a todos por destinar tiempo en mi consulta.

Saludos cordiales.

formato (2).txt

Smako · el 20 de mayo

Hola Maret, creo que tu problema puede estar en esta parte:

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,

Con eso tu estas copiando y pegando valores únicamente, lo que no modifica el formato del destino donde estás pegando. Dices que antes si funcionaba? Puedes adjuntar tu archivo para revisarlo?

maret · el 20 de mayo

Hola Maret, creo que tu problema puede estar en esta parte:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,

Con eso tu estas copiando y pegando valores únicamente, lo que no modifica el formato del destino donde estás pegando. Dices que antes si funcionaba? Puedes adjuntar tu archivo para revisarlo?

Hola Smako, muchas gracias por tu respuesta. Te comento que yo intente cambiar xlPasteValues por xlPasteFormats y no me funciona tampoco.

El libro 1 es el que anda bien.

El libro 2 no. Se le agrego el modulo 7 y en la hoja PODER_RESCATE se le agrego las dos lineas y campos que van desde la celda C37 hasta L39.

El modulo 5 es el que copia estos valores y genera el archivo definitivo. Y este es donde tengo el problema.

Te comento que es un archivo en red, que funciona dependiendo de otros archivos, seguramente te va a tirar un problema de conexion, lo omites y recien ahí vas a poder ver el archivo sin algunas funciones, pero vas a poder ver el código.

Te adjunto el libro y desde ya muchísimas gracias por tu gran ayuda. Ojala me puedas ayudar a resolver este gran problema que tengo.

No me deja adjuntar la página, pero te dejo el libro en google Drive:

https://docs.google.com/file/d/0B8hnsr9iLJJ7cmJBOHJic29ISFU/edit?usp=sharing

Ojala lo puedas ver, decime cualquier cosa. Y nuevamente mil gracias.

Smako · el 20 de mayo

Aparentemente la hoja que usas para copiar tiene algún problema que posiblemente se solucione volviendola a crear. Se lo molesto que puede ser eso, por lo que te dejo otra opción, pruebalo y me dices si te sirve: Download libro2 modificado.zip from Sendspace.com - send big files the easy way es tu mismo archivo, solo arreglé la parte en la que tenías problemas

maret · el 20 de mayo

Aparentemente la hoja que usas para copiar tiene algún problema que posiblemente se solucione volviendola a crear. Se lo molesto que puede ser eso, por lo que te dejo otra opción, pruebalo y me dices si te sirve: Download libro2 modificado.zip from Sendspace.com - send big files the easy way es tu mismo archivo, solo arreglé la parte en la que tenías problemas

Hola, muchas gracias!!! te hago una consulta, el modulo que creaste afecta bien a una de las hojas. Pero el archivo genera dos, una se llama hoja1 (GRAL) y la otra se llama hoja2(PODER_RESCATE).

Como puedo modificarlo para que me afecte a las dos? O que debería hacer?

Mil gracias por tu excelente ayuda!!! no sé como agradecerte ya!

Smako · el 21 de mayo

Listo Marte, aqui lo tienes Download Libro 2 modificado.zip from Sendspace.com - send big files the easy way, avisame si necesitas algo mas

maret · el 23 de mayo

Hola Smako! mil gracias, sos un genio!!! no quiero abusar de amabilidad, pero a lo mejor me puedes dar una idea. El archivo anda perfecto en mi PC y en otra, pero en otras dos NO, la solapa de PENDIENTE debe tomar un archivo en red y al apretar actualizar en las dos PCS no patchea la dirección. Tenes idea si le puede faltar algun archivo en particular a la PC, como ser un parche o algo así para que funcione?

Nuevamente gracias por la gran ayuda que me has dado. Por otro lado, hay alguna manera de que pueda agradecerte todo lo que em ayudaste?

Abrazo!

Smako · el 23 de mayo

Hola Smako! mil gracias, sos un genio!!! no quiero abusar de amabilidad, pero a lo mejor me puedes dar una idea. El archivo anda perfecto en mi PC y en otra, pero en otras dos NO, la solapa de PENDIENTE debe tomar un archivo en red y al apretar actualizar en las dos PCS no patchea la dirección. Tenes idea si le puede faltar algun archivo en particular a la PC, como ser un parche o algo así para que funcione?
Nuevamente gracias por la gran ayuda que me has dado. Por otro lado, hay alguna manera de que pueda agradecerte todo lo que em ayudaste?

Abrazo!

Buen día Maret, creo que tendrías que verificar que estén habilitadas las macros en las 2 PC y que no tengan ningún problema de acceso a la red, en específico a la dirección de donde se obtiene la información para el archivo. Al ser un problema local ya es un poco mas complejo ayudarte, pero en lo que pueda aquí estoy. Y de lo demás, no te preocupes que con las gracias y la satisfacción de saber que te ayude es suficiente.