VBA macro-is there a faster way to copy-paste special?

S

simbah

New Member
Joined
Feb 20, 2009
Messages
6
Dear all,

I created the following simple macro using macro recorder in Excel 2007. However, the process was slow and took a minute or so to complete. Do you believe that this is a result of the extensive usage of Selection?
Is there a quicker method to do it?

Thanks.

Thanks.
hary
================
Sub Save_1()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'
' Save_1 Macro
'

'
Range("F5:G5").Select
Selection.Copy
Sheets("List_of_inputted_item").Select
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form_input").Select
ActiveCell.Offset(2, 0).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List_of_inputted_item").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form_input").Select
ActiveCell.Offset(2, 0).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List_of_inputted_item").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form_input").Select
ActiveCell.Offset(2, 0).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List_of_inputted_item").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form_input").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List_of_inputted_item").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form_input").Select
ActiveCell.Offset(2, -1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List_of_inputted_item").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form_input").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("List_of_inputted_item").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form_input").Select
ActiveCell.Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveCell.Offset(-2, -1).Range("A1").Select
Selection.ClearContents
ActiveCell.Offset(-4, 0).Range("A1:B1").Select
Selection.ClearContents
ActiveCell.Offset(-2, 0).Range("A1:B1").Select
Selection.ClearContents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Hi
Welcome in here
Can you explain what are you trying to do with this code?
 
Upvote 0
Hi there,

Thank you for your reply.
Basically, I want to copy-paste special from sheet "Form_input" to sheet "List_of_inputted_item" as below. By using relative reference;
- Content in sheet "Form_input" cells F5:G5 copied-special into sheet "List_of_inputted_item" column A.
- Content in sheet "Form_input" cells F7:G7 copied-special into sheet "List_of_inputted_item" column B.
- Content in sheet "Form_input" cells F9:G9 copied-special into sheet "List_of_inputted_item" column C.
- Content in sheet "Form_input" cell F11 copied-special into sheet "List_of_inputted_item" column D.
- Content in sheet "Form_input" cell G11 copied-special into sheet "List_of_inputted_item" column E.
- Content in sheet "Form_input" cell F13 copied-special into sheet "List_of_inputted_item" column F.
- Content in sheet "Form_input" cell G13 copied-special into sheet "List_of_inputted_item" column G.
- Delete content in sheet "Form_input" cell G13.
- Delete content in sheet "Form_input" cell F11.
- Delete content in sheet "Form_input" cell F7:G7.
- Delete content in sheet "Form_input" cell F5:G5.

regards
 
Upvote 0
Can you be more specific about the cells in sheet "List_of_inputted_item"?
Ex. you mentioned sheet "Form_input" cells F5:G5 -> sheet "List_of_inputted_item" column A ... Which cells in column A?
etc
 
Upvote 0
Am I right to assume that F5:G5, F7:G7 and F9:G9 are merged cells? Since you want the contents of those cells copied into a single column.
 
Upvote 0
VBA Code: 
Sub Macro1()

' First we identify the last row with data on worksheet LIST_OF_INPUTTED_ITEM
' I am going to assume here that cells can remain blank, that's why I am taking a rather long way around.
' This is  a bit of a sledgehammer approach, but it is guaranteed to work even if cells are empty.
' If you are sure one of the columns is ALWAYS filled in, then you can directly refer to that column.
    lastrow_with_data_a = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "A").End(xlUp).Row
    lastrow_with_data_b = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "B").End(xlUp).Row
    lastrow_with_data_c = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "C").End(xlUp).Row
    lastrow_with_data_d = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "D").End(xlUp).Row
    lastrow_with_data_e = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "E").End(xlUp).Row
    lastrow_with_data_f = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "F").End(xlUp).Row
    lastrow_with_data_g = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "G").End(xlUp).Row
    First_empty_row = WorksheetFunction.Max(lastrow_with_data_a, lastrow_with_data_b, lastrow_with_data_c, lastrow_with_data_d, lastrow_with_data_e, lastrow_with_data_f, lastrow_with_data_g) + 1

' Transfer items worksheet FORM_INPUT to worksheet LIST_OF_INPUTTED_ITEM
    Sheets("List_of_inputted_item").Range("A" & First_empty_row) = Sheets("Form_Input").Range("F5").Value
    Sheets("List_of_inputted_item").Range("B" & First_empty_row) = Sheets("Form_Input").Range("F7").Value
    Sheets("List_of_inputted_item").Range("C" & First_empty_row) = Sheets("Form_Input").Range("F9").Value
    Sheets("List_of_inputted_item").Range("D" & First_empty_row) = Sheets("Form_Input").Range("F11").Value
    Sheets("List_of_inputted_item").Range("E" & First_empty_row) = Sheets("Form_Input").Range("G11").Value
    Sheets("List_of_inputted_item").Range("F" & First_empty_row) = Sheets("Form_Input").Range("F13").Value
    Sheets("List_of_inputted_item").Range("G" & First_empty_row) = Sheets("Form_Input").Range("G13").Value

' Remove the contents of worksheet FORM_INPUT
    Sheets("Form_Input").Range("F5:G5").ClearContents
    Sheets("Form_Input").Range("F7:G7").ClearContents
    Sheets("Form_Input").Range("F11").ClearContents
    Sheets("Form_Input").Range("G13").ClearContents
   
End Sub
 
Upvote 0
Solution
petertenthije said:
VBA Code: 
Sub Macro1()

' First we identify the last row with data on worksheet LIST_OF_INPUTTED_ITEM
' I am going to assume here that cells can remain blank, that's why I am taking a rather long way around.
' This is  a bit of a sledgehammer approach, but it is guaranteed to work even if cells are empty.
' If you are sure one of the columns is ALWAYS filled in, then you can directly refer to that column.
    lastrow_with_data_a = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "A").End(xlUp).Row
    lastrow_with_data_b = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "B").End(xlUp).Row
    lastrow_with_data_c = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "C").End(xlUp).Row
    lastrow_with_data_d = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "D").End(xlUp).Row
    lastrow_with_data_e = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "E").End(xlUp).Row
    lastrow_with_data_f = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "F").End(xlUp).Row
    lastrow_with_data_g = Sheets("List_of_inputted_item").Cells(Sheets("List_of_inputted_item").Rows.Count, "G").End(xlUp).Row
    First_empty_row = WorksheetFunction.Max(lastrow_with_data_a, lastrow_with_data_b, lastrow_with_data_c, lastrow_with_data_d, lastrow_with_data_e, lastrow_with_data_f, lastrow_with_data_g) + 1

' Transfer items worksheet FORM_INPUT to worksheet LIST_OF_INPUTTED_ITEM
    Sheets("List_of_inputted_item").Range("A" & First_empty_row) = Sheets("Form_Input").Range("F5").Value
    Sheets("List_of_inputted_item").Range("B" & First_empty_row) = Sheets("Form_Input").Range("F7").Value
    Sheets("List_of_inputted_item").Range("C" & First_empty_row) = Sheets("Form_Input").Range("F9").Value
    Sheets("List_of_inputted_item").Range("D" & First_empty_row) = Sheets("Form_Input").Range("F11").Value
    Sheets("List_of_inputted_item").Range("E" & First_empty_row) = Sheets("Form_Input").Range("G11").Value
    Sheets("List_of_inputted_item").Range("F" & First_empty_row) = Sheets("Form_Input").Range("F13").Value
    Sheets("List_of_inputted_item").Range("G" & First_empty_row) = Sheets("Form_Input").Range("G13").Value

' Remove the contents of worksheet FORM_INPUT
    Sheets("Form_Input").Range("F5:G5").ClearContents
    Sheets("Form_Input").Range("F7:G7").ClearContents
    Sheets("Form_Input").Range("F11").ClearContents
    Sheets("Form_Input").Range("G13").ClearContents
  
End Sub
Click to expand...
Hello petertenthije

I appreciate your support. The aforementioned code runs just as I had imagined it would.
The execution procedure took ~50% less time to complete than it did before, and I can live with that.

Again, I appreciate your and the other guys' help. It's great to be a part of this group.
Cheers
 
Upvote 0
@simbah See if the following works faster for you:

VBA Code: 
Sub Macro1V2()
'
    Dim StartTime   As Double
    StartTime = Timer                                                                                                                   ' Start the stop watch
'
    First_empty_row = Sheets("List_of_inputted_item").Range("A:G").Find("*", , xlFormulas, , xlByRows, xlPrevious).Row + 1              ' Get first empty row # after last used cell in range A:G
'
    With Sheets("Form_Input")
        Set RangeToCopy = Union(.Range("F5"), .Range("F7"), .Range("F9"), .Range("F11"), .Range("G11"), .Range("F13"), .Range("G13"))   ' Load the cells to copy into RangeToCopy
    End With
'
    ReDim RangeArray(1 To RangeToCopy.Cells.Count)                                                                                      ' Establish 1D 1 Based RangeArray to store the values
'
    For Each Cel In RangeToCopy.Cells                                                                                                   ' Loop through cells in RangeToCopy
        x = x + 1                                                                                                                       '   Increment x
        RangeArray(x) = Cel.Value                                                                                                       '   Save cell value into RangeArray
    Next                                                                                                                                ' Loop back
'
    Sheets("List_of_inputted_item").Range("A" & First_empty_row).Resize(1, UBound(RangeArray)).Value = RangeArray                       ' Display the values from RangeArray to the sheet
'
    Sheets("Form_Input").Range("F5, F7, F9, F11, G11, F13, G13").ClearContents                                                          ' Clear contents of desired cells
'
    MsgBox "Completed in " & Timer - StartTime & " seconds."                                                                            ' Display completion time to the user
End Sub
 
Upvote 0
johnnyL said:
@simbah See if the following works faster for you:

VBA Code: 
Sub Macro1V2()
'
    Dim StartTime   As Double
    StartTime = Timer                                                                                                                   ' Start the stop watch
'
    First_empty_row = Sheets("List_of_inputted_item").Range("A:G").Find("*", , xlFormulas, , xlByRows, xlPrevious).Row + 1              ' Get first empty row # after last used cell in range A:G
'
    With Sheets("Form_Input")
        Set RangeToCopy = Union(.Range("F5"), .Range("F7"), .Range("F9"), .Range("F11"), .Range("G11"), .Range("F13"), .Range("G13"))   ' Load the cells to copy into RangeToCopy
    End With
'
    ReDim RangeArray(1 To RangeToCopy.Cells.Count)                                                                                      ' Establish 1D 1 Based RangeArray to store the values
'
    For Each Cel In RangeToCopy.Cells                                                                                                   ' Loop through cells in RangeToCopy
        x = x + 1                                                                                                                       '   Increment x
        RangeArray(x) = Cel.Value                                                                                                       '   Save cell value into RangeArray
    Next                                                                                                                                ' Loop back
'
    Sheets("List_of_inputted_item").Range("A" & First_empty_row).Resize(1, UBound(RangeArray)).Value = RangeArray                       ' Display the values from RangeArray to the sheet
'
    Sheets("Form_Input").Range("F5, F7, F9, F11, G11, F13, G13").ClearContents                                                          ' Clear contents of desired cells
'
    MsgBox "Completed in " & Timer - StartTime & " seconds."                                                                            ' Display completion time to the user
End Sub
Click to expand...
 
Upvote 0
Hello @johnnyL,
Thank you for providing the code. I tried it, but the time required to complete was roughly the same as with @petertenthije (~25 sec).
Surprisingly, after running the code, my formula in this sheet vanished.
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
186
Possum17
P
N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
169
DanteAmor
DanteAmor
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
299
Azamamir
A
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
159
shknbk2
S
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
166
pennbowl
P

Forum statistics

Threads
1,214,641
Messages
6,120,691
Members
448,978
Latest member
rrauni

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top