Practing vba code with copy and pasting , need help

I

ILeonFF

New Member
Joined
Jun 20, 2018
Messages
18
How do i go about consolidating this VBA Code for copying and pasting

Code: 
Sub Button24_Click()
Sheets("General Information").Select
    ActiveWindow.SmallScroll Down:=27
    Range("D53:F53").Select
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("B3").Select
    Sheets("General Information").Select
    Range("D55:F55").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("B4").Select
    Sheets("General Information").Select
    Range("D56:F56").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("B5").Select
    Sheets("FA-PCIF Header").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("B6").Select
    Sheets("General Information").Select
    ActiveWindow.SmallScroll Down:=-27
    Range("D17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("B7").Select
    Sheets("General Information").Select
    Range("E17:F17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("B8").Select
    Sheets("General Information").Select
    Range("D19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("B9").Select
    Sheets("General Information").Select
    Range("D12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("B10").Select
    Sheets("General Information").Select
    ActiveWindow.SmallScroll Down:=9
    Range("D33").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("B11").Select
    Sheets("General Information").Select
    Range("D20:K23").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B12").Select

    Sheets("General Information").Select
    ActiveWindow.SmallScroll Down:=15
    Range("D39").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Mechanical Design Summary").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B16").Select

End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
Hi,

What do you mean by "consolidation"?

By the look of the code it has come from a recorded macro?

Is it running too slow for you?

A couple of quick tips-

1. delete the scroll parts of the code.
2. you don't need to "select" anything to do something.
3. adding
Code: 
ScreenUpdating=False
at the beginning of your code and
Code: 
ScreenUpdating=True
at the end of your code will made it run faster.

hope that helps,

FS
 
Upvote 0
farmerscott said:
Hi,

What do you mean by "consolidation"?

By the look of the code it has come from a recorded macro?

Is it running too slow for you?

A couple of quick tips-

1. delete the scroll parts of the code.
2. you don't need to "select" anything to do something.
3. adding
Code: 
ScreenUpdating=False
at the beginning of your code and
Code: 
ScreenUpdating=True
at the end of your code will made it run faster.

hope that helps,

FS
Click to expand...

Yeah its a recorded macro. What i mean by consolidation is to essentially remove any redundancies if possible and if there are any rewrites in the code just to make it more condensed(if that makes any sense).
Thank you for your suggestions i have implemented them.
 
Upvote 0
You can get rid of the .Select & Selection like this
Code: 
With Sheets("General Information")
   .Range("D53:F53").Copy
   Sheets("Mechanical Design Summary").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   
   .Range("D55:F55").Copy
   Sheets("Mechanical Design Summary").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   
   .Range("D56:F56").Copy
   Sheets("Mechanical Design Summary").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
End With
It could also be slimmed down further by the use of loops.But if you rewrite your code like I've shown (& check that it works), then post that to the board, we can have another look
 
Upvote 0
Fluff said:
You can get rid of the .Select & Selection like this
Code: 
With Sheets("General Information")
   .Range("D53:F53").Copy
   Sheets("Mechanical Design Summary").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   
   .Range("D55:F55").Copy
   Sheets("Mechanical Design Summary").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   
   .Range("D56:F56").Copy
   Sheets("Mechanical Design Summary").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
End With
It could also be slimmed down further by the use of loops.But if you rewrite your code like I've shown (& check that it works), then post that to the board, we can have another look
Click to expand...

Okay i have added everything that was suggested. And everything works great. Thank you so much. Here is the code below
Code: 
Sub Macro4()
ScreenUpdating = False
'
  With Sheets("General Information")
   .Range("D53:F53").Copy
   Sheets("Mechanical Design Summary").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
        
    .Range("D55:F55").Copy
   Sheets("Mechanical Design Summary").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
        
    .Range("D56:F56").Copy
   Sheets("Mechanical Design Summary").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
          
    .Range("D17").Copy
   Sheets("Mechanical Design Summary").Range("B6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
       
    .Range("E17:F17").Copy
   Sheets("Mechanical Design Summary").Range("B7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
       
   .Range("D19").Copy
   Sheets("Mechanical Design Summary").Range("B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
        
    [COLOR=#ff0000].Range("D12").Copy
   Sheets("Mechanical Design Summary").Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False[/COLOR]
           
     [COLOR=#000000].Range("D33").Copy
   Sheets("Mechanical Design Summary").Range("B10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False[/COLOR]
       
    .Range("D20:K23").Copy
   Sheets("Mechanical Design Summary").Range("B11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
    
    .Range("D39").Copy
   Sheets("Mechanical Design Summary").Range("B12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
        
End With
      
With Sheets("FA-PCIF Header")
   .Range("D17:I17").Copy
   Sheets("Mechanical Design Summary").Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
       
End With

ScreenUpdating = True
End Sub

For the text code in red i need to have an IF statement in them. How would i go about adding something like this?:
Code: 
[COLOR=#ff0000]
[/COLOR][COLOR=#008000]If "D12" = "None" [/COLOR][COLOR=#ff0000]
[/COLOR][COLOR=#008000].Range("E12:F12").Copy[/COLOR][COLOR=#ff0000]
   Sheets("Mechanical Design Summary").Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
[/COLOR][COLOR=#008000]Else [/COLOR]
[COLOR=#ff0000][COLOR=#ff0000].Range("D12").Copy
   Sheets("Mechanical Design Summary").Range("B9").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False[/COLOR][/COLOR]
 
Last edited:
Upvote 0
Ok, try this
Code: 
Sub Macro4()
   Dim Ary As Variant, i As Long
Application.ScreenUpdating = False

   Ary = Array("D53:F53", "D55:F55", "D56:F56", "", "D17", "E17:F17", "D19", "D12", "D33", "D20:K23", "D39")
   With Sheets("General Information")
      For i = 0 To UBound(Ary)
         If Not Ary(i) = vbNullString Then
            If Ary(i) = "D12" And .Range("D12") = "None" Then Ary(i) = "E12:F12"
            .Range(Ary(i)).Copy
            Sheets("Mechanical Design Summary").Range("B" & i + 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
         End If
      Next i
   End With

   With Sheets("FA-PCIF Header")
      .Range("D17:I17").Copy
      Sheets("Mechanical Design Summary").Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
   End With

Application.ScreenUpdating = True
End Sub
 
Upvote 0
Fluff said:
Ok, try this
Code: 
Sub Macro4()
   Dim Ary As Variant, i As Long
Application.ScreenUpdating = False

   Ary = Array("D53:F53", "D55:F55", "D56:F56", "", "D17", "E17:F17", "D19", "D12", "D33", "D20:K23", "D39")
   With Sheets("General Information")
      For i = 0 To UBound(Ary)
         If Not Ary(i) = vbNullString Then
            If Ary(i) = "D12" And .Range("D12") = "None" Then Ary(i) = "E12:F12"
            .Range(Ary(i)).Copy
            Sheets("Mechanical Design Summary").Range("B" & i + 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
         End If
      Next i
   End With

   With Sheets("FA-PCIF Header")
      .Range("D17:I17").Copy
      Sheets("Mechanical Design Summary").Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
   End With

Application.ScreenUpdating = True
End Sub
Click to expand...

Everything worked like a charm thank you once again.
Can you explain what is going on with this part in the code. I need to add another exception just like "D12" but for "D33", was hoping it'd be simple to add in there but im a little lost on whats going on in the code.

Code: 
For i = 0 To UBound(Ary)          
            If Not Ary(i) = vbNullString Then
            If Ary(i) = "D12" And .Range("D12") = "None" Then Ary(i) = "E12:F12"
            .Range(Ary(i)).Copy
            Sheets("Mechanical Design Summary").Range("B" & i + 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        End If
     Next i
 
Last edited:
Upvote 0
This part of the code is looping through the array
Code: 
      For i = 0 To UBound(Ary)
         [COLOR=#ff0000]If Not Ary(i) = vbNullString Then[/COLOR]
            [COLOR=#0000ff]If Ary(i) = "D12" And .Range("D12") = "None" Then Ary(i) = "E12:F12"[/COLOR]
            .Range(Ary(i)).Copy
            Sheets("Mechanical Design Summary").Range("B" & i + 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
         End If
      Next i
So for the first time through it will copy range D53:F53, then next time it will copy D55:F55 etc.
The part in red checks to see if the value in the array is "". This is in order to skip pasting data to cell B5
The part in blue checks to see if the array value is D12 & if so it checks if D12=None. If it does it replaces the value in the array with E12:F12
To check the value of D33 you can copy the blue line, & paste underneath, then modify as required.
 
Upvote 0
Fluff said:
This part of the code is looping through the array
Code: 
      For i = 0 To UBound(Ary)
         [COLOR=#ff0000]If Not Ary(i) = vbNullString Then[/COLOR]
            [COLOR=#0000ff]If Ary(i) = "D12" And .Range("D12") = "None" Then Ary(i) = "E12:F12"[/COLOR]
            .Range(Ary(i)).Copy
            Sheets("Mechanical Design Summary").Range("B" & i + 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
         End If
      Next i
So for the first time through it will copy range D53:F53, then next time it will copy D55:F55 etc.
The part in red checks to see if the value in the array is "". This is in order to skip pasting data to cell B5
The part in blue checks to see if the array value is D12 & if so it checks if D12=None. If it does it replaces the value in the array with E12:F12
To check the value of D33 you can copy the blue line, & paste underneath, then modify as required.
Click to expand...

Your explanation was perfect, Thank you.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
187
kbk
K
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
244
willow1985
willow1985
J
  • Solved
Continuous Copy and paste
2
Replies
10
Views
166
Joe4
Joe4
brent3162
  • Solved
VBA help with increasing row before macro runs again.
Replies
3
Views
343
jolivanes
jolivanes
C
  • Question Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
419
myall_blues
myall_blues

Forum statistics

Threads
1,223,228
Messages
6,170,875
Members
452,363
Latest member
merico17

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