マクロは実行されますが、あまりうまく行かず、通常はクラッシュします（私のPC全体と一緒に）

Question

明らかに私はVBAの最初のマクロ（そして私は爆発的なものでした）毎回クラッシュします。どのように私はそれをより効率的に実行できるようにするためのヒントがありますか？

PS - 私は特別なペーストを行う必要があります/ので（数式を持っていた）空白のセルは私ができるの操作で非ブランクとして

Sub DTC_Generator() 

Application.EnableEvents = False 'Prevents screen from moving through cells/events' 
Application.ScreenUpdating = False 'Prevents screen from tabbing' 
Application.CutCopyMode = False 'prevents gray residue after copy/paste' 
Application.DisplayStatusBar = False 


'LOOP RANGE 

Dim A As Integer 
Lstrow = Sheet4.Range("A" & Rows.Count).End(xlUp).Row 

For A = 2 To Lstrow 

    Sheet4.Activate 
    Range("A2").End(xlDown).Select 

    Lstrow = ActiveCell.Row 

    Cells(A, 1).Copy 

    Range("L1").Activate 
    ActiveCell.PasteSpecial Paste:=xlPasteValues 

    'BEGIN MACRO 


    'PASTE PRE-GENERATOR ATTRIBUTES 

    Sheet4.Activate 

    Range("AA2:AL36").Delete 

    Range("M2:X36").Copy 
    Range("AA2:AL36").PasteSpecial Paste:=xlPasteValues 
    Range("AA2:AL36").Copy 

    Sheet7.Activate 
    Range("A2").PasteSpecial Paste:=xlPasteValues 
    Range("A2:AL36").Select 
    Selection.Replace What:="", Replacement:="£", LookAt:=xlWhole, _ 
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
      ReplaceFormat:=False 
    Range("A2:AL36").Select 
    Selection.Replace What:="£", Replacement:="", LookAt:=xlWhole, _ 
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
      ReplaceFormat:=False 
    'DElETE OLD DATA 


    'SELECT ATTRIBUTE DATA 

    Sheet7.Activate 

    Range("M2").Select 

    'Loops through unique values until "no" 

    Do Until ActiveCell = "No" 
     ActiveCell.Offset(1, 0).Select 
    Loop 

    'bumps it back 1 row and over 19 columns' 

    ActiveCell.Offset(-1, 19).Select 
    ActiveCell.Name = "Bottom_Left" 
    Range("BH2:Bottom_Left").Copy 

    'PASTE INTO ATTRIBUTE INPUT FILE' 

    Sheet2.Activate 

    Range("A:A").End(xlDown).Offset(1, 0).Select 
    Lastrow = ActiveCell.Row 
    Cells(Lastrow, 1).PasteSpecial Paste:=xlPasteValues 

Next A 

MsgBox ("success?") 


End Sub 

Answer 1

を貼り付けますスタンジェのバグ（£）を交換見つけます確かなことではありませんが、次のことがあなたの「クラッシュ」問題の迅速な修正であると推測しています。

変更：

Do Until ActiveCell.Value2 = "No" or ActiveCell.Value2 = vbNullString 
    ActiveCell.Offset(1, 0).Select 
Loop 

へ

Do Until ActiveCell = "No" 
    ActiveCell.Offset(1, 0).Select 
Loop 

実は私は、これは1が常に、すべての可能な場合（Do ... Loopを回避しようとすべき理由プライム場合のように、この記事のためにあなたに感謝しなければなりません）。この種のループは永遠に続き、until節の「exit point」が不適切に選択されたときにExcelをクラッシュさせる傾向があります。この場合、ActiveCellの値がNoになるまで続けるべきだと言います。しかし、次の利用可能なセルにNoが含まれていない可能性があることを忘れています。したがって、このループがデータグリッド（UsedRange）を超えた場合、行1,048,576以降であっても、Noを探し続けることになります。これにより、Excelが簡単にクラッシュする可能性があります。

Answer 2

同じことを何度も繰り返してもらうようにしているように見えます。 'for a = 2 to lastrow'と書くと、それはそれと次のaの間のすべてに行きます。この例では36回です。あなたはそれをするつもりでしたか？ 36回行うことのうちの1つは、無限ループです：「アクティブセルまで」はセルを選択するだけです。実行する必要があるすべてが「ループ」の下にあるように見えます。つまり、アクティブなセルごとに実行されません。プラス、 'アクティブセル=いいえ'が見つからない場合は、決して終了しません（無限ループ）、クラッシュします。

私はあなたが達成しようとしているものを推測しましたが、ループの後には失われました。私はあなたを助けるためにあなたが始まってコメントをするためのコードを書いています。あなたがループでやろうとしていることを教えてください。私は助けようとします。

Sub DTC_Generator() 

Application.EnableEvents = False 'Prevents screen from moving through cells/events' 
Application.ScreenUpdating = False 'Prevents screen from tabbing' 
Application.CutCopyMode = False 'prevents gray residue after copy/paste' 
Application.DisplayStatusBar = False 

Sheet4.Name = "DTC_Generator" 'by naming the sheet you can work 'with' it, 
'thereby making the code specific to this workbook so if you have other workbooks open it will not get confused 
'about which workbook it's processing 

'avoid selecting and activating if at all possible, saves time/cpu resources 

Dim A As Long 'integer is limited in its length, just go ahead and always use Long for numbers 
Dim Lastrow1 As Long 
Dim Lastrow2 As Long 
Dim Lastrow As Long 
Dim x As Variant 

With ThisWorkbook 

    With .Sheets("DTC_Generator") 

    'seems like the data you want to use is in columns M:X so goon base last row on those 
    Lastrow1 = .Range("M" & Rows.Count).End(xlUp) 
    Lastrow2 = .Range("X" & Rows.Count).End(xlUp) 
    If Lastrow2 > Lastrow1 Then Lastrow = Lastrow2 Else Lastrow = Lastrow1 


    .Cells.ClearFormats 'remove if you need to keep formats 
    .Cells.Copy 'get more specific if you need to keep formulas 
    .Range("A1").PasteSpecial xlPasteValues 
    .Columns("A").Value = .Columns("A").Value 'this does the whole column at once, no need to loop through each cell 
    .Range("L1").Value = .Range("A2").Value 'you were doing this for each cell in column A, doesn't seem right so I moved it here but you can move it if you need to 
    'you were also recalculating your lastrow for every cell in A 

    .Range("M2:X" & Lastrow).Copy 
    .Range("AA2").PasteSpecial xlPasteValues 
    Application.CutCopyMode = False 

    'you don't need to move it to a separate sheet to clean it up 
    'you may not need to do this at all, uncomment if you do 
    '.Columns("AA:AAL").Replace What:="", Replacement:="£", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 
    '.Columns("AA:AAL").Replace What:="£", Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False 

     'this is better than a loop cuz it will def just do the range so an infinite loop won't happen and crash you 
     'i think your "Do Until ActiveCell = "No"" was meant to loop through M2:X36, if so, do this 
     For Each x In Range(.Range("M2"), .Range("M" & Rows.Count).End(xlUp)) 

     '*************************************************** 
     'YOU LOST ME AFTER THIS - WHAT ARE YOU TRYING TO DO? 
     '*************************************************** 

     Next x 

    End With 

End With 

'be sure to turn stuff back on 
Application.EnableEvents = True 
Application.ScreenUpdating = True 
Application.DisplayStatusBar = True 

MsgBox "success?" 

End Sub