Reducir formulación de macro, se ejecuta muy lento..
Para ejecutar la macro final depende de varias macros adicionales, la cual se demora en hacer el proceso, por lo cual pido su apoyo en poder disminuir todo el procesos, estas son las macros de acuerdo a cada procesos:
MACRO FINAL:
Sub Compra_Elimina_Hoja_Pegar_con_VBA()
Application.ScreenUpdating = False
Hoja21.Cells.Clear
Worksheets("CABECERA").Range("A2:AM4").Copy _
Worksheets("CONCAR").Range("A1")
Worksheets("COMPRAS").Range("F8:F300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E4:F294").Select
Selection.NumberFormat = "m/d/yyyy"
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("O8:O300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("H8:H300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("J4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0)"
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J294"), Type:=xlFillDefault
Range("J4:J294").Select
Range("J4").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-1],CABECERA!R12C2:R19C4,3,0),"""")"
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J294")
Range("J4:J294").Select
Selection.Copy
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("L8:L300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("J4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("AC8:AC300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("K4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("C8:C300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("L4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("O8:O300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("M4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("AZ8:AZ300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("N4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("AY8:AY300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("O4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("Q8:R300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("P4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("Z8:Z300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("S4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("W8:W300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("R4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Worksheets("COMPRAS").Range("AR8:AR300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("X4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Call Concatenar
Worksheets("COMPRAS").Range("AX8:AX300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("Y4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Call LIMPIAR
Worksheets("COMPRAS").Range("AV8:AW300").Select
Selection.Copy
Sheets("CONCAR").Select
Range("AA4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("COMPRAS").Select
Range("W8").Select
Sheets("CONCAR").Select
Range("R4").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
Application.ScreenUpdating = True
FRM_LISTO.Show
End Sub
MACRO ADICIONAL 1:
Sub Concatenar()
fila = 8
Do While Range("AA" & fila) <> ""
Range("AX" & fila) = "=CONCATENATE(IF(RC[-5]="""","""",TEXT(RC[-5],""0000-"")),IF(RC[-5]="""","""",""-""),RC[-3])"
fila = fila + 1
Loop
End Sub
MACRO ADICIONAL 2:
Sub LIMPIAR()
If ActiveSheet.Index = 4 Then
CUO = Hoja8.Range("AQ1")
Hoja8.Range("AX8:AX" & CUO).Value = ""
End If
End Sub