Sub documento_unico()
'
' documento_unico Macro
'
'
archivo_lt10 = InputBox("Introduce el archivo lt10 de traspasos a ...TRANSIT")
archivoconruta = "C:\temp\Macro Operadores\" & archivo_lt10 & ".xls"
'Workbooks.OpenText Filename:="C:\temp\Macro Operadores\" & archivo_lt10 & ".xls", Origin:= _
932, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _
), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1)), _
TrailingMinusNumbers:=True
Workbooks.OpenText Filename:="C:\temp\Macro Operadores\" & archivo_lt10 & ".xls", _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:= _
Array(1, 1)
Rows("1:4").Select Selection.Delete Shift:=xlUp
Columns("A:A").Select Selection.Delete Shift:=xlToLeft
Columns("D:D").Select Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("H:H,M:M,F:F").Select Range("M1").Activate Selection.NumberFormat = "0"
Range("A1").Select ActiveCell.FormulaR1C1 = "Número de EM"
Range("B1").Select ActiveCell.FormulaR1C1 = "CR/P1"
Range("C1").Select ActiveCell.FormulaR1C1 = "Material"
Range("D1").Select ActiveCell.FormulaR1C1 = "Proveedor"
Range("E1").Select ActiveCell.FormulaR1C1 = "Denominación"
Range("F1").Select ActiveCell.FormulaR1C1 = "Stock"
Range("G1").Select ActiveCell.FormulaR1C1 = "UN"
Range("H1").Select ActiveCell.FormulaR1C1 = "UA"
Range("I1").Select ActiveCell.FormulaR1C1 = "Alm"
Range("J1").Select ActiveCell.FormulaR1C1 = "Ubicación"
Range("K1").Select ActiveCell.FormulaR1C1 = "Ctro"
Range("L1").Select ActiveCell.FormulaR1C1 = "Fecha Trasp"
Range("M1").Select ActiveCell.FormulaR1C1 = "Lote insp"
Range("N1").Select ActiveCell.FormulaR1C1 = "Hora"
Workbooks.Open Filename:="C:\temp\Macro Operadores\Materiales_Proveedor.xls"
Workbooks(archivo_lt10 & ".xls").Activate
Range("D2").Select ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Materiales_Proveedor.xls]Hoja1'!C1:C4,4,FALSE)"
Range("E2").Select ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-2],'[Materiales_Proveedor.xls]Hoja1'!C1:C4,2,FALSE)"
Fin = 0
For cont = 3 To 65536
If Cells(cont, 1) <> "" Then
Range("D2:E2").Select Selection.Copy
Range("D" & cont & ":E" & cont).Select ActiveSheet.Paste
Fin = 0
End If
If Cells(cont, 1) = "" Then
Fin = Fin + 1
If Fin = 2 Then
Exit For
End If
End If
Next
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1:N1").Select With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2
Columns("A:N").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Rows("1:1").Select Range("C1").Activate Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("D:D").Select Selection.Cut
Columns("B:B").Select Selection.Insert Shift:=xlToRight
Columns("A:A").Select Selection.EntireColumn.Hidden = True
Cells.Select
'Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
Columns("A:N").Select Range("N1").Activate Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("D2") _ , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
Workbooks.Open Filename:="C:\temp\Macro Operadores\Piezas ubicacion fija.xls"
Workbooks(archivo_lt10 & ".xls").Activate
Columns("I:I").Select Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Fin = 0
For cont = 2 To 65536
If Cells(cont, 1) <> "" Then
Range("J" & cont).Select ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-6],'[Piezas ubicacion fija.xls]Hoja1'!C1:C4,4,FALSE)"
Range("J" & cont).Select Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J" & cont).Select 'Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Replace What:="#N/A", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
'Cells.Find(What:="#N/A", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
'Range("I" & cont).Select
'ActiveCell.FormulaR1C1 = "=IF(RC[1]=0,RC[3],RC[1])"
If Cells(cont, 10) = 0 Then
Cells(cont, 9) = Cells(cont, 12)
Else
Cells(cont, 9) = Cells(cont, 10)
Rows(cont).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
End If
Range("I" & cont).Select Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Fin = 0
End If
If Cells(cont, 1) = "" Then
Fin = Fin + 1
If Fin = 2 Then
Exit For
End If
End If
Next
Range("J:J,L:L").Select Range("L1").Activate Selection.Delete Shift:=xlToLeft
Range("I1").Select ActiveCell.FormulaR1C1 = "Ubicación"
Rows("1:1").RowHeight = 27 Columns("B:B").ColumnWidth = 24 Columns("C:C").ColumnWidth = 4 Columns("D:D").ColumnWidth = 11 Columns("E:E").ColumnWidth = 22 Columns("G:G").ColumnWidth = 3 Columns("H:H").ColumnWidth = 12 Columns("I:I").ColumnWidth = 13 Columns("L:L").ColumnWidth = 9
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.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 = 100
'.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub
Sub rojo()
'
' ROJO Macro
'
'
Columns("I:I").Select With Application.ReplaceFormat.Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Replace What:="XXXX", Replacement:="XXXX", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
ActiveWorkbook.Worksheets("doc").Sort.SortFields.Clear ActiveWorkbook.Worksheets("doc").Sort.SortFields.Add Key:=Range("I2:I84"), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("doc").Sort .SetRange Range("I1:I84") .Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("K5").SelectEnd Sub
