title: Optimize Excel VBA Macro for Copy-PasteValues
body: <p>I'm new in Excel-VBA and I need to improve my macro performance. I have a macro that searches an excel, opens it, then goes through every sheet and copy-pastevalues for all cell with a specific color (yellow). Finally saves and closes the excel. In addition, excels sheets are locked and only those yellow cells are editable. This should be done for a list of excel that I indicate in a main template from where I call the macro. The problem is that it takes a lot of time and even gets blocked when the number of excels is more than 3.</p>
  <p>I paste my code below and hope anyone can help. Thanks!</p>
  <pre><code>Sub Button1_Click()
  
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
  
      Dim filePath As String
      Dim rng As Range
      Dim cel As Range
      Dim cartera As String
      Dim plantilla As String
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim obj_Cell As Range
  
      filePath = Application.ThisWorkbook.Path
      
      Range(&quot;B9&quot;).Select
      Set rng = Application.Range(Selection, Selection.End(xlDown))
      
      For Each cel In rng.Cells
          cartera = cel.Value
          plantilla = cel.Offset(0, 1).Value
          
          If cartera = vbNullString Or plantilla = vbNullString Then
              GoTo Saltar
          End If
          
          Application.StatusBar = &quot;Ejecutando Cartera: &quot; &amp; cartera &amp; &quot;, Plantilla: &quot; &amp; plantilla
          
          Set wb = Workbooks.Open(filePath &amp; &quot;\&quot; &amp; cartera &amp; &quot;\&quot; &amp; plantilla, UpdateLinks:=3)
          
          For Each ws In wb.Worksheets
              If ws.Name &lt;&gt; &quot;Index&quot; And ws.Name &lt;&gt; &quot;Instructions&quot; And ws.Name &lt;&gt; &quot;Glossary&quot; Then
                  Worksheets(ws.Name).Activate
                  For Each obj_Cell In Range(&quot;A1:DW105&quot;)
      
                      With obj_Cell
                          If obj_Cell.Interior.Color = RGB(255, 255, 153) Then
                              obj_Cell.Select
                              If obj_Cell.MergeCells = True Then
                                  obj_Cell.MergeArea.Select
                              End If
                              Selection.Copy
                              Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
                              If obj_Cell.MergeCells = True Then
                                  If obj_Cell.MergeArea(1).Value = vbNullString Then
                                      obj_Cell.MergeArea.Cells(1, 1).Select
                                      Selection.ClearContents
                                  End If
                              Else
                                  If obj_Cell.Value = vbNullString Then
                                      obj_Cell.ClearContents
                                  End If
                              End If
                          End If
                      End With
                      
                  Next obj_Cell
                  
                  Range(&quot;A1&quot;).Select
              End If
          Next ws
          
          Sheets(1).Select
          wb.Close SaveChanges:=True
          
  Saltar:
  
      Next cel
      
      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
      Application.StatusBar = False
  End Sub
  </code></pre>