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
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
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
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