在VBA中剪切，粘贴和插入行/列行太慢

时间：2019-02-24 11:41:51

标签： vba performance runtime

我为我公司的日常运作运行了有关MRP系统和采购团队关键项目的代码。通过更改公式的位置，插入，删除某些行/列，插入注释，它基本上重新格式化了MRP和关键项目输出。该代码最初运行了10到20秒，但是我添加的更改越多，运行时间就越长（100-150秒）。我逐行运行了代码，并分析了花费最多的时间是关于剪切/粘贴/插入部分。代码如下，如果需要，我可以共享输入文件。有人可以建议吗？

在下面需要花费太多时间的代码行之前，我说“花费很长时间” 

Sub KritikMRP()

Dim IhtiyacSutunu As Integer
Dim ColumnLetterIhtiyacSutunu As String
Dim StokYetersizSutunu As Integer
Dim ColumnLetterStokYetersizSutunu As String
Dim ColumnLetterIlkGun As String
Dim ColumnLetterIkinciGun As String
Dim ColumnLetterSonGun As String
Dim LastRow As Integer
Dim start As Date
Dim UserName As String
Dim sheet As String
Dim NewLastRow As Integer
Dim GoBack As Integer
Dim wb As Workbook
Dim wb2 As Workbook
Dim wbname As String
Dim lrow As Double
Dim lcol As Double
Dim lcolLetter As String
Dim lcolLetterM1 As String
Dim lcolLetterM2 As String
Dim lcolLetterM3 As String
Dim lcolLetterM4 As String
Dim lcolLetterM5 As String
Dim firstTime As Integer
Dim Answer As Integer
Dim Dummy As Integer
Dim DummyColumn As String
Dim TestStr As String
Dim ThisDate As Date
Dim YesterDay As Date
Dim YesterDayM As String
Dim YesterdayY As Double

Call OptimizeCode_Begin

start = Now()


'MRP START





Windows("MainFile.xlsx").Activate

For y = 1 To Workbooks("MainFile.xlsx").Worksheets.Count
    If Workbooks("MainFile.xlsx").Sheets(y).Name = "MRP" Then

Sheets("MRP").Activate
    Range("A:W").Select

    Selection.Copy

   ' Windows("Kritik - MRP Uygulaması.xlsm").Activate
   Windows(wbname).Activate
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste


'
Cells(2, 2).Value = "Malzeme Adı"
Cells(2, 4).Value = "Satıcı Adı"
Cells(2, 21).Value = "Miktar"
Cells(2, 22).Value = "Lead Time"
Cells(2, 23).Value = "MRP Stok Yeterliliği"

' SatırSil Macro
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp

Columns("W:W").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Columns("V:V").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight


    Columns("H:H").Select
    Application.CutCopyMode = False
    Selection.Cut
    Columns("K:K").Select
    Selection.Insert Shift:=xlToRight

'Find last row
 Range("A1").Select
    Selection.End(xlDown).Select
    LastRow = ActiveCell.Row

' NewSheetOpener Macro
'
sheet = ActiveSheet.Name

'
    Range("A1:W" & LastRow).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste

 Worksheets(sheet).Delete


Range("A1").Select
Selection.End(xlToRight).Select
GoBack = ActiveCell.Column

Range(Cells(2, GoBack + 1), Cells(2, GoBack + 1)).FormulaR1C1 = "=IFERROR(VALUE(RC[-" & GoBack & "]),RC[-" & GoBack & "])"

    Range(Cells(2, GoBack + 1), Cells(2, GoBack + 1)).Select
    Selection.AutoFill Destination:=Range(Cells(2, GoBack + 1), Cells(2, GoBack + 23)), Type:=xlFillDefault


    Range(Cells(2, GoBack + 1), Cells(2, GoBack + 23)).Select
     Selection.AutoFill Destination:=Range(Cells(2, GoBack + 1), Cells(LastRow, GoBack + 23))

    Range(Cells(2, GoBack + 1), Cells(LastRow, GoBack + 23)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



 Range(Cells(2, GoBack + 1), Cells(LastRow, GoBack + 23)).Select
    Application.CutCopyMode = False
    Selection.Copy

    Range("A2").Select
    ActiveSheet.Paste
    Range("J2:N2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy"

Range(Cells(2, GoBack + 1), Cells(LastRow, GoBack + 23)).Value = ""



'isim degistir freeze panes, filtrele ve #'leri sil



    Range("A2").Select
    ActiveWindow.FreezePanes = True
    Range("K1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "'Mal Hazır Olma Tarihi"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "'Varış Tarihi"
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter

    Range(Cells(1, 1), Cells(LastRow, GoBack)).Select
    Selection.Replace What:="#", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False



    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "E2:E" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "B2:B" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range( _
        "L2:L" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:W" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With





'SUBTOTAL

    Range("A1:W" & LastRow).Select
    Range("A2").Activate
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True

'Find new last row

 Range("A1").Select
    Selection.End(xlDown).Select
    NewLastRow = ActiveCell.Row


'Renklendirmeler Macro
'BURASI HIZLANABİLİR Mİ?
For i = 2 To NewLastRow


If InStr(1, Cells(i, 1).Value, "Total") > 0 Then
GoTo TotalBoyama
End If

If Cells(i, 6).Value = "SAS" Then
GoTo SASBoyama
End If

If Cells(i, 6).Value = "AB" Or Cells(i, 6).Value = "LA" Then
GoTo ABveLABoyama
End If

GoTo ending


' TotalBoyamaca

TotalBoyama:

    Rows(i & ":" & i).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With

    Selection.Font.Bold = True

    GoTo ending

'AB/LA Boyamaca

ABveLABoyama:

    Range(Cells(i, 6), Cells(i, 6)).Select
    With Selection.Font
        .Color = -11489280
        .TintAndShade = 0
    End With

    Selection.Font.Bold = True


If Cells(i, 6).Value = "AB" And Cells(i, 18).Value = "" Then
GoTo BookingOlmayanAB
End If


GoTo ending

SASBoyama:

'SASBoyama

    Range(Cells(i, 6), Cells(i, 6)).Select
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True


GoTo ending

' BookingOlmayanAB Macro

BookingOlmayanAB:

    Range(Cells(i, 12), Cells(i, 12)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True

    Range(Cells(i, 11), Cells(i, 11)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True

Range(Cells(i, 6), Cells(i, 6)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True

'DAYS TO CARGO READY HESAPLAT

Cells(i, 24).Value = DateValue(Cells(i, 11).Value) - ThisDate
GoTo ending

ending:


'Taşıma önerisinde Critical Air, Critical Ocean, Train/Truck.., Truck/Air olanlar bunları bold + Kırmızı fontlar!
If Cells(i, 15).Value = "Critical Air" Or Cells(i, 15).Value = "Critical Ocean Deliv" Or Cells(i, 15).Value = "Short Term Critic" Or Cells(i, 15).Value = "Train/Truck/Air Deli" Or Cells(i, 15).Value = "Truck/Air Delivery" Then
 Cells(i, 15).Select
 Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    GoTo ending2
End If

'Ocean ile As Planned'e yeşil'e boya boldla
If Cells(i, 15).Value = "As Planned" Or Cells(i, 15).Value = "Ocean Delivery" Then
 Cells(i, 15).Select
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -11489280
        .TintAndShade = 0
    End With
End If


ending2:

Next i

'Genel format düzenlemeleri

' VarışMalHazırBoyama

VarisHazirOlma:

    Range("K1:L1").Select
    Range("L1").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColor = 0
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColor = 0
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

'Calibrileme

    Range("A1:W" & NewLastRow).Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With



'Son Düzenleme

Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("G:G").Select
    Selection.Style = "Comma"
    Selection.NumberFormat = "_-* #,##0.0_-;-* #,##0.0_-;_-* ""-""??_-;_-@_-"
    Selection.NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"





ActiveSheet.Name = "MRP Raporu"
'Move it to a new worksheet
'Windows("Kritik - MRP Uygulaması.xlsm").Activate
Windows(wbname).Activate
Sheets("MRP Raporu").Select

TestStr = Dir("C:\Users\" & UserName & "\Desktop\Günlük\" & Year(ThisDate) & "\" & MonthName(Month(ThisDate)) & "\" & ThisDate & " Kritik-MRP-İthalat.xlsx")
If TestStr = "" Then
 Set wb2 = Workbooks.Add
wb2.SaveAs Filename:="C:\Users\" & UserName & "\Desktop\Günlük\" & Year(ThisDate) & "\" & MonthName(Month(ThisDate)) & "\" & ThisDate & " Kritik-MRP-İthalat.xlsx"
'Windows("Kritik - MRP Uygulaması.xlsm").Activate
Windows(wbname).Activate
End If
Sheets("MRP Raporu").Move After:=Workbooks(ThisDate & " Kritik-MRP-İthalat.xlsx").Sheets(1)

'AutoFit
Windows(ThisDate & " Kritik-MRP-İthalat.xlsx").Activate
 Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.AutoFilter
    Selection.AutoFilter


'SATLARI AYIRMA BAŞLA


'
' SATvePL Macro
   lrow = Cells(Rows.Count, 1).End(xlUp).Row

    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$W$" & lrow).AutoFilter Field:=6, Criteria1:= _
        "=Planlı sipariş", Operator:=xlOr, Criteria2:="=Satınalma talebi"






    'Cells.Select
    'Selection.Copy
    'Sheets.Add After:=ActiveSheet

    'TAKES VERY LONG TIME

    'ActiveSheet.Paste
   sheet = ActiveSheet.Name
   Sheets.Add After:=ActiveSheet
   Worksheets(sheet).Cells.Copy Destination:=Range("A1")


  sheet = ActiveSheet.Name


    'Columns("H:K").Select
    'Application.CutCopyMode = False
        'TAKES VERY LONG TIME

    'Selection.Delete Shift:=xlToLeft

    Columns("H:K").Delete Shift:=xlToLeft
    Columns("I:S").Delete Shift:=xlToLeft
    'Columns("I:S").Select
       'TAKES VERY LONG TIME

    'Selection.Delete Shift:=xlToLeft

   'LAST ROW DELETE
   Range("A1").Select
    Selection.End(xlDown).Select
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    'Rows(LastRow & ":" & LastRow).Select
    'Selection.Delete Shift:=xlUp
    Rows(LastRow & ":" & LastRow).Delete Shift:=xlUp
     Range("A1:B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets(sheet).AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(sheet).AutoFilter.Sort.SortFields.Add Key:=Range _
        ("F2:F" & LastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal

    With ActiveWorkbook.Worksheets(sheet).AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'SELECT ETTİRECEĞİZ
    Range("A1:B1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    'SELECT ETTİK

     'TAKES VERY LONG TIME

    Selection.Subtotal GroupBy:=6, Function:=xlSum, TotalList:=Array(7), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True



Range("A2").Select
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
lcolLetter = Split(Cells(1, lcol).Address, "$")(1)

    Cells.Find(What:="Satınalma talebi Total", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate

    Selection.Cut
    Range("A" & ActiveCell.Row).Select
    ActiveSheet.Paste
    Range("A" & ActiveCell.Row & ":" & lcolLetter & ActiveCell.Row).Select

     With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Selection.Font.Bold = True

    Range("A2").Select
    Cells.Find(What:="Planlı sipariş Total", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate

    Selection.Cut
    Range("A" & ActiveCell.Row).Select
    ActiveSheet.Paste

    Range("A" & ActiveCell.Row & ":" & lcolLetter & ActiveCell.Row).Select

     With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Selection.Font.Bold = True


    Range("F" & ActiveCell.Row + 1).Select
    Selection.Cut
    Range("A" & ActiveCell.Row).Select
    ActiveSheet.Paste



   'SAT FORMAT
   lrow = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
lcolLetter = Split(Cells(1, lcol).Address, "$")(1)

     ActiveSheet.Range("$A$1:$" & lcolLetter & "$" & lrow).AutoFilter Field:=6, Criteria1:= _
        "Satınalma talebi"


        lrow = Cells(Rows.Count, 1).End(xlUp).Row

    Range("A2:" & lcolLetter & lrow).Select
      Selection.SpecialCells(xlCellTypeVisible).Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With


       ActiveSheet.Range("$A$1:$" & lcolLetter & "$" & lrow).AutoFilter Field:=6


    'PL SİP FORMAT
            lrow = Cells(Rows.Count, 1).End(xlUp).Row

        ActiveSheet.Range("$A$1:$" & lcolLetter & "$" & lrow).AutoFilter Field:=6, Criteria1:= _
        "Planlı sipariş"

                lrow = Cells(Rows.Count, 1).End(xlUp).Row

    Range("A2:" & lcolLetter & lrow).Select
   Selection.SpecialCells(xlCellTypeVisible).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
          ActiveSheet.Range("$A$1:$" & lcolLetter & "$" & lrow).AutoFilter Field:=6


    'BORDERLARI ÇİZDİR
                    lrow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:" & lcolLetter & lrow).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With



    'GRAND TOTAL BOYA
    Range("A" & lrow & ":" & lcolLetter & lrow).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With

    Selection.Font.Bold = True



    'BORDERLAR ÇİZİLDİ

    Range("A2").Select
    ActiveWindow.FreezePanes = True
    Cells.Select
    Cells.EntireColumn.AutoFit

'Rename sheet
 ActiveSheet.Name = "SAT ve PS"

'SATLARI AYIRMA BİTİR

Sheets("MRP Raporu").Select
    ActiveSheet.Range("A:W").AutoFilter Field:=6


'MAL HAZIR VE VARIŞ TARİHLERİYLE ALAKALI REVİZYON

'YER DEĞİŞTİR
 Columns("L:L").Select
    Selection.Cut
    Columns("K:K").Select

      'TAKES VERY LONG TIME

    Selection.Insert Shift:=xlToRight




'Days to cargo Ready başlığını at ve formatla

Cells(1, 24).Value = "Days to Cargo Ready"
Cells(1, 23).Select
Selection.Copy
    Range("X1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False


Columns("E:E").Select
    Selection.Cut
    Columns("M:M").Select
      'TAKES VERY LONG TIME

    Selection.Insert Shift:=xlToRight
    Columns("G:H").Select
    Selection.Cut
    Columns("F:F").Select
     'TAKES VERY LONG TIME

    Selection.Insert Shift:=xlToRight
    Columns("T:T").Select
    Selection.Cut
    Columns("M:M").Select
        'TAKES VERY LONG TIME

    Selection.Insert Shift:=xlToRight



'AutoFit
 Cells.Select
    Cells.EntireColumn.AutoFit
lrow = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column




Range(Cells(1, 1), Cells(lrow, lcol)).Select

Selection.AutoFilter
Selection.AutoFilter
'MRP END
End If
Next y


'Kapanış

Windows("MainFile.Xlsx").Activate

For y = 1 To Workbooks("MainFile.xlsx").Worksheets.Count
    If Workbooks("MainFile.xlsx").Sheets(y).Name = "MRP" Then

 Sheets(Array("MRP")).Select
    Sheets(Array("MRP")).Copy Before:=Workbooks( _
        ThisDate & " Kritik-MRP-İthalat.xlsx").Sheets(1)
    Windows("MainFile.xlsx").Activate
    Application.WindowState = xlNormal
    Windows(ThisDate & " Kritik-MRP-İthalat.xlsx").Activate
    Sheets(Array("MRP")).Select
    ActiveWindow.SelectedSheets.Visible = False
End If
Next y

Windows("MainFile.Xlsx").Activate

For y = 1 To Workbooks("MainFile.xlsx").Worksheets.Count
    If Workbooks("MainFile.xlsx").Sheets(y).Name = "Kritik" Then

 Sheets(Array("Kritik")).Select
    Sheets(Array("Kritik")).Copy Before:=Workbooks( _
        ThisDate & " Kritik-MRP-İthalat.xlsx").Sheets(1)
    Windows("MainFile.xlsx").Activate
    Application.WindowState = xlNormal
    Windows(ThisDate & " Kritik-MRP-İthalat.xlsx").Activate
    Sheets(Array("Kritik")).Select
    ActiveWindow.SelectedSheets.Visible = False
End If
Next y

Workbooks("MainFile.xlsx").Close False
Workbooks(wbname).Close False
Windows(ThisDate & " Kritik-MRP-İthalat.xlsx").Activate
For y = 1 To Workbooks(ThisDate & " Kritik-MRP-İthalat.xlsx").Worksheets.Count
    If Workbooks(ThisDate & " Kritik-MRP-İthalat.xlsx").Sheets(y).Name = "Sheet1" Then
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
GoTo OUTANDOUT
End If
Next y

OUTANDOUT:
Windows(ThisDate & " Kritik-MRP-İthalat.xlsx").Activate



Call OptimizeCode_End



MsgBox "Bu uygulama " & Format((Now() - start) * 24 * 60 * 60, "0.00") & " saniyede calisti"

Workbooks("Kritik - MRP Uygulaması.xlsm").Close False

End Sub

0 个答案:

没有答案
相关问题
最新问题