Sub Trabaja1064()
'
' Trabaja1064 Macro
'
'PINTA VERDE VENTA
Range("F3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'PINTA AMARILLO PIEZAS
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
'PASA LOS VALORES DE E - H
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("H3").Select
ActiveSheet.Paste
'ELIMINA VALORES DE D
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
'PASA LOS VALORES DE C A L
Range("C3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("L3").Select
ActiveSheet.Paste
'PASA LOS VALORES DE AyB - ByC
Range("A3:B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste
'RELLENA COLUMNA A
'toma un rango a partir de la fila 4 a 2000
For i = 4 To 2000
'indica si la celda 2 est� vacia
If Not IsEmpty(Cells(i, 2)) Then
'entonces escribe valor en la columna A
Cells(i, 1).Value = "10642"
End If
Next i
'RELLENA COLUMNA E
'toma un rango a partir de la fila 4 a 2000
For i = 4 To 2000
'indica si la celda 2 est� vacia
If Not IsEmpty(Cells(i, 2)) Then
'entonces escribe valor en la columna E
Cells(i, 5).Value = "0"
End If
Next i
'RELLENA COLUMNA I
'toma un rango a partir de la fila 4 a 2000
For i = 4 To 2000
'indica si la celda 2 est� vacia
If Not IsEmpty(Cells(i, 2)) Then
'entonces escribe valor en la columna I
Cells(i, 9).Value = "xx"
End If
Next i
'RELLENA COLUMNA K
'toma un rango a partir de la fila 4 a 2000
For i = 4 To 2000
'indica si la celda 2 est� vacia
If Not IsEmpty(Cells(i, 2)) Then
'entonces escribe valor en la columna K
Cells(i, 11).Value = "xx"
End If
Next i
'RELLENA COLUMNA M
'toma un rango a partir de la fila 4 a 2000
For i = 4 To 2000
'indica si la celda 2 est� vacia
If Not IsEmpty(Cells(i, 2)) Then
'entonces escribe valor en la columna M
Cells(i, 13).Value = "xx"
End If
Next i
'RELLENA COLUMNA N
'toma un rango a partir de la fila 4 a 2000
For i = 4 To 2000
'indica si la celda 2 est� vacia
If Not IsEmpty(Cells(i, 2)) Then
'entonces escribe valor en la columna N
Cells(i, 14).Value = "CONCENTRADO"
End If
Next i
'RELLENA COLUMNA O
'toma un rango a partir de la fila 4 a 2000
For i = 4 To 2000
'indica si la celda 2 est� vacia
If Not IsEmpty(Cells(i, 2)) Then
'entonces escribe valor en la columna O
Cells(i, 15).Value = "Autoservicio"
End If
Next i
'ELIMINA FILA 3
Rows("3:3").Select
Range("C3").Activate
Selection.Delete Shift:=xlUp
'SELECCIONA Y DA FORMATO A TODA LA HOJA
Cells.Select
With Selection.Font
.Name = "Arial"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Cells.EntireColumn.AutoFit
'FORMATO A COLUMNAS E,FyG
Range("E3:G3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "0.00"
End Sub