¿Como programar Macro en Excel 2007 para ingresar datos en una celda vacia?
Estoy realizando una base de datos en excel para llevar un inventario de stock con entrada y salida de materiales con la ayuda de unos tutoriales en internet. La macro que cree me permite hacer la entrada de datos pero los datosse escriben en una misma celda siempre y quisiera saber si es posible llevar el registro total de moviento de entrada y salidas
Anexo Macro
Sub INGRESO()
'
' INGRESO Macro
'
Application.ScreenUpdating = False
Range("Tabla2[NUMERO DE PARTE]").Select
Selection.Copy
Sheets("Stock").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Pedido").Select
Range("Tabla2[DESCRIPCIÓN]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Stock").Select
Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Pedido").Select
Range("Tabla2[MARCA]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Stock").Select
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Pedido").Select
Range("Tabla1[MOVIMIENTO]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Stock").Select
Range("E7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Pedido").Select
Range("Tabla1[CANTIDAD]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Stock").Select
Range("F7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Pedido").Select
Range("Tabla2[COSTO]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Stock").Select
Range("G7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Pedido").Select
Range("Tabla1[VENDEDOR]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Stock").Select
Range("H7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Pedido").Select
Range("Tabla1[FECHA]").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Stock").Select
Range("I7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Pedido").Select
Application.CutCopyMode = False
End Sub
A la espera de alguna respuesta
2 Respuestas
H o l a : Te anexo la macro.
Sub IngresoStock()
'Act.Por.Dante Amor
' INGRESO Macro
'
Application.ScreenUpdating = False
Set h1 = Sheets("Pedido")
Set h2 = Sheets("Stock")
'
u = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
h1.Range("Tabla2[NUMERO DE PARTE]").Copy
h2.Range("B" & u).PasteSpecial Paste:=xlPasteValues
h1.Range("Tabla2[DESCRIPCIÓN]").Copy
h2.Range("C" & u).PasteSpecial Paste:=xlPasteValues
h1.Range("Tabla2[MARCA]").Copy
h2.Range("D" & u).PasteSpecial Paste:=xlPasteValues
h1.Range("Tabla1[MOVIMIENTO]").Copy
h2.Range("E" & u).PasteSpecial Paste:=xlPasteValues
h1.Range("Tabla1[CANTIDAD]").Copy
h2.Range("F" & u).PasteSpecial Paste:=xlPasteValues
h1.Range("Tabla2[COSTO]").Copy
h2.Range("G" & u).PasteSpecial Paste:=xlPasteValues
h1.Range("Tabla1[VENDEDOR]").Copy
h2.Range("H" & u).PasteSpecial Paste:=xlPasteValues
h1.Range("Tabla1[FECHA]").Copy
h2.Range("I" & u).PasteSpecial Paste:=xlPasteValues
'
Application.CutCopyMode = False
End SubSería más práctico, si en la hoja de "pedido", tuvieras una sola tabla, los encabezados de la hoja "pedido" y hoja "stock" estuvieran en el mismo orden y en una sola fila estuvieran los datos a copiar; de esa manera solamente tendrías que copiar un rango y pegar una sola vez.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Tienes que añadir El código en negrita en tu macro después de cada vez que seleccionas una columna. Para B7 sería:
.
.
.
Range("B7").Select
If Activecell.Value <>""
Do
Activecell.offset(1,0).Select
Loop until Activecell.value = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End if
Sheets("Pedido").Select
Range("Tabla2[DESCRIPCIÓN]").Select
.
.
.
.