More Efficient Code

[Rubber Beaked Woodpecker]

The following code works very well but it run a couple of hundred times a day and each my pc cpu is briefly 100%

Anyone think that it could be written in a more efficient way to save my pc pls?

Sub Reports()
   
Dim source As Worksheet
Dim destination As Worksheet
Dim emptyColumn As Long

Set source = Sheets("Sheet1")
Set destination = Sheets("Sheet8")

source.Range("Z2:Z40").Copy

emptyColumn = destination.Cells(28, destination.Columns.Count).End(xlToLeft).Column

If IsEmpty(destination.Range("A28")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
       
Else
    emptyColumn = emptyColumn + 1
    destination.Cells(28, emptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
  destination.Cells(28, emptyColumn).PasteSpecial Paste:=xlPasteFormats
  
    
End If
   
End Sub

 

[Michael M]

What do you call briefly 100%.......milliseconds ??

 

[DanteAmor]

Hi @Rubber Beaked Woodpecker. Thanks for posting on the forum.

Instead of copying and pasting and then pasting the formats. I suggest the following:
1. Before executing the macro, copy the cells "Z2:Z40" from sheet1, select sheet8, select entire rows from row 28 to row 66, paste formatting, use paste special, paste Formats.
That way the formatting will already be in all the rows and it won't be necessary to paste it every time.

2. Instead of copying and pasting values, what we will do is pass the values from sheet1 to sheet8.

3. I suppose that this part of the code is to paste the data as a header and I also suppose that it is only done once. So you could remove it from the code.

If IsEmpty(destination.Range("A28")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True

Try the following macro:

Sub Reports()
  Dim source As Worksheet, destination As Worksheet
  Dim emptyColumn As Long
  Dim a As Variant
 
  Set source = Sheets("Sheet1")
  Set destination = Sheets("Sheet8")
 
  a = source.Range("Z2:Z40").Value
  emptyColumn = destination.Cells(28, destination.Columns.Count).End(xlToLeft).Column
 
  If IsEmpty(destination.Range("A28")) Then
    destination.Cells(1, 1).PasteSpecial Transpose:=True
  Else
    emptyColumn = emptyColumn + 1
    destination.Cells(28, emptyColumn).Resize(UBound(a, 1)).Value = a
  End If
End Sub

If point 3 is correct, the code can be simplified like this:

Sub Reports()
  Dim a As Variant
  a = Sheets("Sheet1").Range("Z2:Z40").Value
  With Sheets("Sheet8")
    .Cells(28, .Cells(28, .Columns.Count).End(1).Column + 1).Resize(UBound(a, 1)).Value = a
  End With
End Sub

It could even be on a single line:

Sub Reports()
  Sheets("Sheet8").Cells(28, Sheets("Sheet8").Cells(28, Columns.Count).End(1).Column + 1).Resize(39).Value = Sheets("Sheet1").Range("Z2:Z40").Value
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

 

[Rubber Beaked Woodpecker]

After testing a little more it is now clear that the CPU usage is caused by the sheet calculating rather than just the copy and paste from sheet1.

If sheet8 is manual calculation I would like to adjust the code so that after copy and paste from sheet1 to sheet8, the code would then find the last populated column in sheet 8 and find all = and replace all = which I believe will force a manual calculation.

This possible please?

RBW