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

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
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
67
wknight7
W
A
  • Solved
copy paste from one worksheet to other but in different columns
2
Replies
18
Views
781
Joe4
Joe4
L
  • Solved
VBA Error
2 3
Replies
29
Views
417
Joe4
Joe4
T
  • Question
This is so slow I have to run it overnight
Replies
4
Views
262
kevin9999
K
gheyman
  • Solved
Copy from one workbook to another (just format and values)
Replies
2
Views
451
gheyman
gheyman

Forum statistics

Threads
1,215,734
Messages
6,126,542
Members
449,316
Latest member
sravya

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