Ingresar datos en una tabla en vista diseño.

Amigo Dam, espero te encuentres muy bien.

Tengo un archivo que actualiza una tabla dinámica que se encuentra en vista tabular ya que solo de esta forma puedo visualizar los datos que necesito. Dicha tabla dinámica la convierto en valores para poder editarla, por el diseño de la tabla dinámica tengo que rellenar los espacios en blanco de la primer columna que esta posicionada en la celda "S6", la tabla es similar a esta:

'Celda S6' 'Celda R6' 'Celda T6' 'Celda U6'

DatosNum A B C

dato1 10 15 20

20 30 40

80 10 5

dato2 20 15 18

15 10 21

dato3 45 20 5

20 10 10

Los espacios en blanco deben de ser llenados dependiendo el valor de la primer columna ejemplo:

<strong style="line-height: 1.5em;">DatosNum A B C

dato1 10 15 20
dato1 20 30 40
dato1 80 10 5
dato2 20 15 18

dato2 15 10 21

dato3 45 20 5

dato3 20 10 10

Los datos de la primer columna pueden ser variables por ejemplo 11 datos diferentes (dato1, dato2, dato3, etc.), tengo el siguiente código.

Sub Rellenar()


Range("T6").Select
Selection.End(xlDown).Offset(1, -1).Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(-1, 0).Select


If (Selection.Value) = "" Then
Range("T6").Select
Selection.End(xlDown).Offset(1, -1).Select
Selection.End(xlUp).Select
Selection.Copy
Range("T6").Select
Selection.End(xlDown).Offset(1, -1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(-1, 0).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.Copy
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False


Else


Range("T6").Select
Selection.End(xlDown).Offset(1, -1).Select
Selection.End(xlUp).Select
Selection.Copy
Range("T6").Select
Selection.End(xlDown).Offset(1, -1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(-1, 0).Select
Selection.End(xlUp).Select
Selection.Copy
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False


End If

Range("T6").Select

Selection.End(xlDown).Offset(1, -1).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.Copy
Selection.End(xlDown).Offset(-1, 0).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False


For i = 1 To 8


ActiveCell.Offset(-1, 0).Select
Selection.End(xlUp).Select
Selection.Copy
Selection.End(xlDown).Offset(-1, 0).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False


Next i


MsgBox "OK", vbExclamation, "OOOk"


End Sub

Este código detecta si el ultimo dato tiene mas de 1 registro o en su defecto solo 1 registro ya que cuando trataba de correr la macro me mandaba un error de compilación pero con la condición if pude corregir ese detalle. Ahora tengo el mismo problema pero ahora en medio de la tabla anexo ejemplo:

'Celda S6' 'Celda R6' 'Celda T6' 'Celda U6'
DatosNum A B C
dato1 10 15 20
20 30 40
80 10 5
dato2 20 15 18

dato3 15 10 21
código no es capaz de detectar esta situación, me podrías ayudar a mejorar mi código ya que no se como realizarlo y por eso recurro al experto.

Saludos amigo..!!

1 respuesta

Respuesta
1

Aplica la siguiente macro

Lo que llamas "Dato1" debe estar en la celda S6, si es otra, en la macro se indica en dónde le debes cambiar.

Sub rellena()
'Por.DAM
c = "S" 'columna donde tienes "dato1"
f = 6 'fila donde tienes "dato1"
d = Columns(c).Column + 1
uf = Cells(Rows.Count, d).End(xlUp).Row
    Range(c & f & ":" & c & uf).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"
    Range(Cells(f, c), Cells(uf, c)).Copy
    Cells(f, c).Select
    Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

Saludos.DAM
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas