Hi could anyone change this vbs so its alot smaller ?

S

ste33uka

Active Member
Joined
Jan 31, 2020
Messages
473
Office Version
  1. 365
Platform
  1. Windows
Hi my excel book keeps loosing its macros, they just vanish, im wondering if i make the code smaller if it could help.
Could anyone make this macro smaller ?
Thank
VBA Code: 
Sub COPY_INTERESTS()
Dim i As Long
   For i = 1 To 101
      With Sheets(CStr(i))
         If LCase(.Range("yo4").Value) = "yes" Then
            .Range("E4:AA7").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
         End If
         If LCase(.Range("yo8").Value) = "yes" Then
           .Range("E8:AA11").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo12").Value) = "yes" Then
           .Range("E12:AA15").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo16").Value) = "yes" Then
            .Range("E16:AA19").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo20").Value) = "yes" Then
           .Range("E20:AA23").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   
         End If
         If LCase(.Range("yo24").Value) = "yes" Then
           .Range("E24:AA27").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo28").Value) = "yes" Then
            .Range("E28:AA31").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
     
         End If
         If LCase(.Range("yo32").Value) = "yes" Then
           .Range("E32:AA35").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      
         End If
         If LCase(.Range("yo36").Value) = "yes" Then
           .Range("E36:AA39").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
       
         End If
         If LCase(.Range("yo40").Value) = "yes" Then
            .Range("E40:AA43").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
         End If
         If LCase(.Range("yo44").Value) = "yes" Then
           .Range("E44:AA47").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        
         End If
         If LCase(.Range("yo48").Value) = "yes" Then
           .Range("E48:AA51").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo52").Value) = "yes" Then
           .Range("E52:AA55").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   
         End If
         If LCase(.Range("yo56").Value) = "yes" Then
           .Range("E56:AA59").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      
         End If
         If LCase(.Range("yo60").Value) = "yes" Then
            .Range("A60:AA63").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
  
         End If
         If LCase(.Range("yo64").Value) = "yes" Then
           .Range("E64:AA67").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      
         End If
         If LCase(.Range("yo68").Value) = "yes" Then
           .Range("E68:AA71").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
     
         End If
         If LCase(.Range("yo72").Value) = "yes" Then
            .Range("E72:AA75").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End If
    If LCase(.Range("yo4").Value) = "yesl" Then
            .Range("E4:AA7").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

    
         End If
         If LCase(.Range("yo8").Value) = "yesl" Then
           .Range("E8:AA11").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo12").Value) = "yesl" Then
           .Range("E12:AA15").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo16").Value) = "yesl" Then
            .Range("E16:AA19").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo20").Value) = "yesl" Then
           .Range("E20:AA23").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   
         End If
         If LCase(.Range("yo24").Value) = "yesl" Then
           .Range("E24:AA27").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo28").Value) = "yesl" Then
            .Range("E28:AA31").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
     
         End If
         If LCase(.Range("yo32").Value) = "yesl" Then
           .Range("E32:AA35").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      
         End If
         If LCase(.Range("yo36").Value) = "yesl" Then
           .Range("E36:AA39").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
       
         End If
         If LCase(.Range("yo40").Value) = "yesl" Then
            .Range("E40:AA43").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
         End If
         If LCase(.Range("yo44").Value) = "yesl" Then
           .Range("E44:AA47").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        
         End If
         If LCase(.Range("yo48").Value) = "yesl" Then
           .Range("E48:AA51").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

         End If
         If LCase(.Range("yo52").Value) = "yesl" Then
           .Range("E52:AA55").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
   
         End If
         If LCase(.Range("yo56").Value) = "yesl" Then
           .Range("E56:AA59").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      
         End If
         If LCase(.Range("yo60").Value) = "yesl" Then
            .Range("A60:AA63").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
  
         End If
         If LCase(.Range("yo64").Value) = "yesl" Then
           .Range("E64:AA67").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      
         End If
         If LCase(.Range("yo68").Value) = "yesl" Then
           .Range("E68:AA71").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
     
         End If
         If LCase(.Range("yo72").Value) = "yesl" Then
            .Range("E72:AA75").Copy
            Workbooks("book1").Sheets("INTERESTS").Range("b1").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End If
         If LCase(.Range("vZ2").Value) = "yes" Then
           .Range("E4:E75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AA" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("Yu4:Yu75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AB" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("yy4:yz75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AC" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("zb4:zb75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AE" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("ZC4:ZC75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AF" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("ZG4:ZH75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AG" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("ZJ4:ZJ75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AI" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("ZT4:ZT75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AJ" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("ZX4:ZY75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AK" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          .Range("AAA4:AAA75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AM" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
           .Range("AAB4:AAJ75").Copy
           Workbooks("book1").Sheets("INTERESTS").Range("AN" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
         End If
      End With
   Next i
End Sub
 
Sort by date Sort by votes
Hi ste33uka,

not so sure what you are talking about - could you please indicate which columns or areas are going wrong (and if it is the wrong place where they should be placed) in the code from #3?


Ciao,
Holger
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
HaHoBe said:
Hi ste33uka,

not so sure what you are talking about - could you please indicate which columns or areas are going wrong (and if it is the wrong place where they should be placed) in the code from #3?


Ciao,
Holger
Click to expand...
your macro works great , thanks alot, problem solved
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Solved
Add a column w/ formula to copy / paste macro
Replies
5
Views
108
wknight7
W
A
  • Solved
copy paste from one worksheet to other but in different columns
2
Replies
18
Views
838
Joe4
Joe4
L
  • Solved
VBA Error
2 3
Replies
29
Views
565
Joe4
Joe4
nathanzumbaugh
  • Solved
Paste cell range below specific named cell(s)
Replies
7
Views
96
nathanzumbaugh
nathanzumbaugh
T
  • Question
This is so slow I have to run it overnight
Replies
4
Views
284
kevin9999
K

Forum statistics

Threads
1,216,309
Messages
6,130,005
Members
449,552
Latest member
8073662045

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