	[x] Posted via EE Mobile
	Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again.

Question

	[x] Attachment Details

[x]

The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

The Grade of the Solution
The Zone Rank of the Expert Providing the Solution
The Number of Author and Expert Comments
The Number of Experts Contributing
The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!

8.5

vba module - create new worksheet and copy values from old spreadsheet

Asked by rgagli1 in Access Coding/Macros, Microsoft Excel Spreadsheet Software, Visual Basic Programming

Tags: vba macro

I want to create a macro that adds an extra worksheet and creates a formula for each cell (from B-S) through the number of rows of the previous (so basically = Sheet1!A1). I have a macro that adds the spreadsheet, how can I create the formulas for 1 - bottomcell?

Thanks

View the Solution FREE for 30 Days

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:

           
           
             Sub Summarize()
   Dim i
   Dim myrange
   Dim bottomCell As Range
   Dim lastcell As Long
   Dim s
   Dim y
   Dim bottomCellminus As Long
   Dim ws As Worksheet
    
   Application.DisplayStatusBar = True
   Application.Calculation = xlCalculationManual
    
   For Each ws In ActiveWorkbook.Worksheets
    
      ' Added: The next line will display which Worksheet is in progress
      Application.StatusBar = "Working on:" & ws.Name & _
      ", which is number " & ws.index & _
      " out of " & ActiveWorkbook.Worksheets.Count & _
      " Sheet(s)."
      
      With ws
         With .PageSetup
            '.PrintTitleRows = "$3:$12"
            .CenterHeader = "&A"
            .CenterFooter = "Page &P of &N"
            .LeftMargin = Application.InchesToPoints(0.694444444444444)
            .RightMargin = Application.InchesToPoints(0.694444444444444)
            .TopMargin = Application.InchesToPoints(0.5)
            .BottomMargin = Application.InchesToPoints(0.5)
            .HeaderMargin = Application.InchesToPoints(0.25)
            .FooterMargin = Application.InchesToPoints(0.25)
            '.PrintHeadings = False
            '.PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .PrintQuality = 600
            .CenterHorizontally = True
            .CenterVertically = False
            .Orientation = xlLandscape
            .Draft = False
            .PaperSize = xlPaperLegal
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = False
            '.FitToPagesWide = 1
            '.FitToPagesTall = False
         End With
        
        Set bottomCell = .Range("C15").End(xlDown)
 
         lastcell = Cells.Find(What:="*", After:=[B1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
         bottomCellminus = bottomCell.Row - 1
          
         X = 15
         If Not (IsEmpty(Cells(2, 15))) Then
         Do While X <= bottomCell.Row
          
            .Cells(X, 15) = "=SUM(C" & X & ":N" & X & ")"
            .Cells(X, 17) = "=(+P" & X & "-O" & X & ")"
            .Cells(X, 19) = "=(+R" & X & "-O" & X & ")"
   '         .Columns("B:S").Select
            X = X + 1
         Loop
         ' set totals formulas
         bottomCell.Resize(, 17).FormulaR1C1 = "=SUM(R15C:R[-1]C)"
          
         With .Columns("C:S")
            .NumberFormat = "#,###;[Red](#,###);_(*  0_)"
            .EntireColumn.AutoFit
         End With
   '      bottomCell = 0
    End If
    
         MName = .Name & ".xls"
         MDir = ActiveWorkbook.Path
         .Copy
          With ActiveWorkbook
            For i = 1 To 56
               .Colors(i) = ThisWorkbook.Colors(i)
            Next i
.ActiveSheet.Range("E15:N" & lastcell).Select
Selection.Locked = False
            .ActiveSheet.Protect Password, True, True, True
            '.ActiveSheet.Columns("E:N").Unprotect
            .Worksheets.Add().Name = "Lookup"
'            With ActiveWorkbo
'            For i = 1 To 56
'               .Colors(i) = ThisWorkbook.Colors(i)
'            Next i
            .ActiveSheet.Cells.Columns.AutoFit
            .SaveAs Filename:=MDir & "\" & MName
            .Close False
          End With
 
     bottomCellminus = 0
     lastcell = 0
      End With
 
   Next ws
 
   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
   Application.StatusBar = False ' <-- Erases the bar & restores control to Excel.
 
 
End Sub

           
         

	Title
1	Need to auto rename the "Sheet1" n…
2	Lookup from one worksheet to another
3	Spreadsheet organization
4	Macro to read data on previous works…
5	Creating spreadsheet templates based …
6	excel link to worksheet

vba module - create new worksheet and copy values from old spreadsheet

Asked by rgagli1 in Access Coding/Macros, Microsoft Excel Spreadsheet Software, Visual Basic Programming

Tags: vba macro

About this solution