Os dejo el código que uso, querría hacer esto pero rellenando toda la hoja.
el problema es que voy añadiendo líneas en vertical y me sobra folio a la derecha el cúal me gustaría rellenar siguiendo esta función.
gracias
Dim I As Integer
Dim nLast As Integer
Dim PrimeraVez As Boolean
Dim FormaP As Double
Dim ContaLin As Integer
Dim DesForma As String
Dim titulo As String
Dim xExcel As Excel.Application
Dim wBook As Workbook
titulo = "Asidep"
If Val(Me.GrdInfoClientes.TextMatrix(Me.GrdInfoClientes.Row, 0)) <= 0 Then
MsgBox "No Hay Datos Para Listar ", vbCritical, titulo
Else
Set xExcel = New Excel.Application
xExcel.Workbooks.Add App.Path & "\ACREDITACION.xlt"
Me.MousePointer = vbHourglass
ContaLin = 7
Total = 0
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
'nombre
xExcel.Range(Chr(Asc("E")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = GrdInfoClientes.TextMatrix(nInd, 2)
xExcel.Selection.HorizontalAlignment = xlCenter
ContaLin = ContaLin + 15
Next nInd
Me.MousePointer = vbHourglass
ContaLin = 9
Total = 0
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
'codigo
xExcel.Range(Chr(Asc("C")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = GrdInfoClientes.TextMatrix(nInd, 0)
xExcel.Range(Chr(Asc("B")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = "ID/Nº"
ContaLin = ContaLin + 15
Next nInd
Me.MousePointer = vbHourglass
ContaLin = 11
Total = 0
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
'equipo
xExcel.Range(Chr(Asc("C")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = GrdInfoClientes.TextMatrix(nInd, 1)
' xExcel.Rows.RowHeight = 19.5
xExcel.Range(Chr(Asc("B")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = "Equipo/Nº"
ContaLin = ContaLin + 15
Next nInd
Me.MousePointer = vbHourglass
ContaLin = 13
Total = 0
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
'pais
xExcel.Range(Chr(Asc("C")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = GrdInfoClientes.TextMatrix(nInd, 3)
xExcel.Range(Chr(Asc("B")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = "Pais"
ContaLin = ContaLin + 15
Next nInd
Me.MousePointer = vbHourglass
ContaLin = 6
Total = 0
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
'Funcion
xExcel.Range(Chr(Asc("E")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = GrdInfoClientes.TextMatrix(nInd, 4)
xExcel.Selection.HorizontalAlignment = xlCenter
ContaLin = ContaLin + 15
Next nInd
Me.MousePointer = vbHourglass
ContaLin = 3
Total = 0
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
'titulo
xExcel.Range(Chr(Asc("E")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = GrdInfoClientes.TextMatrix(nInd, 5)
xExcel.Selection.HorizontalAlignment = xlCenter
ContaLin = ContaLin + 15
Next nInd
Me.MousePointer = vbHourglass
ContaLin = 4
Total = 0
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
'foto
xExcel.Range(Chr(Asc("E")) & ContaLin).Select
'xExcel.ActiveSheet.Pictures.Insert (GrdInfoClientes.TextMatrix(nInd, 6))
'xExcel.ActiveSheet.Pictures.Select
'xExcel.Selection.ShapeRange.LockAspectRatio = msoFalse
'xExcel.Selection.ShapeRange.Height = 57#
'xExcel.Selection.ShapeRange.Width = 51#
'xExcel.Selection.ShapeRange.Rotation = 0#
xExcel.Rows(ContaLin).RowHeight = 57.75
ContaLin = ContaLin + 15
Next nInd
Me.MousePointer = vbHourglass
ContaLin = 9
Total = 0
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
'logo
xExcel.Range(Chr(Asc("F")) & ContaLin).Select
'xExcel.ActiveSheet.Pictures.Insert (GrdInfoClientes.TextMatrix(nInd, 7))
' xExcel.ActiveSheet.Pictures.Select
' xExcel.Selection.ShapeRange.LockAspectRatio = msoFalse
' xExcel.Selection.ShapeRange.Height = 57#
' xExcel.Selection.ShapeRange.Width = 51#
'xExcel.Selection.ShapeRange.Rotation = 0#
ContaLin = ContaLin + 15
Next nInd
''!!!!!!!!!!Plantilla excel(caracteristicas)!!!!!!!!!!!!!!
'ocultar fila 5
ContaLin = 5
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("a")) & ContaLin).Select
xExcel.Rows(ContaLin).RowHeight = 0
ContaLin = ContaLin + 15
Next nInd
ContaLin = 1
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("a")) & ContaLin).Select
xExcel.Rows(ContaLin).RowHeight = 4.25
ContaLin = ContaLin + 15
Next nInd
ContaLin = 2
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("a")) & ContaLin).Select
xExcel.Rows(ContaLin).RowHeight = 5.25
ContaLin = ContaLin + 15
Next nInd
ContaLin = 10
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("a")) & ContaLin).Select
xExcel.Rows(ContaLin).RowHeight = 11.25
ContaLin = ContaLin + 15
Next nInd
ContaLin = 12
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("a")) & ContaLin).Select
xExcel.Rows(ContaLin).RowHeight = 11.25
ContaLin = ContaLin + 15
Next nInd
ContaLin = 14
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("F")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = "Desde"
ContaLin = ContaLin + 15
Next nInd
ContaLin = 15
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("F")) & ContaLin).Select
xExcel.ActiveCell.FormulaR1C1 = "Hasta"
ContaLin = ContaLin + 15
Next nInd
'PIntar raya desde/hasta
ContaLin = 13
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("a")) & ContaLin).Select
xExcel.Rows(ContaLin).Select
xExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeTop).LineStyle = xlNone
With xExcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
xExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone
ContaLin = ContaLin + 15
Next nInd
'!!!!!!!!Recuadro
ContaLin = 30
For nInd = 1 To Me.GrdInfoClientes.Rows - 1
xExcel.Range(Chr(Asc("a")) & ContaLin).Select
xExcel.Rows(ContaLin).Select
xExcel.Rows(ContaLin).Select
xExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeTop).LineStyle = xlNone
With xExcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
xExcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone
ContaLin = ContaLin + 15
Next nInd
'fijas
xExcel.Columns("A:A").Select
xExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeTop).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With xExcel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
xExcel.Columns("G:G").Select
xExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeTop).LineStyle = xlNone
xExcel.Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With xExcel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
xExcel.Columns("B:B").Select
xExcel.Selection.Font.Name = "Trebuchet MS"
xExcel.Selection.Font.Size = 11
xExcel.Selection.Font.Bold = True
....