Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium


How do I copy data from a worksheet to a Summary listing on another worksheet?

Posted on 2015-02-07
Medium Priority
Last Modified: 2016-02-10
Hello Experts,

This is a continuation of http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28588137.html and the updated code is below.

In addition to copying the worksheets, I'd like to copy parameters from the "Calc" worksheet to a "Summary" worksheet. The Summary worksheet has 7 columns and the copied info needs to be added to the bottom of the list. Here's the mapping from the Calc worksheet to the Summary worksheet:

Calc:P1 -> column 1
Calc:P3 -> column 2
Calc:X71 -> column 3
Calc:x73 -> column 4
Calc:W67 -> column 5
Calc:X67 -> column 6
Calc:w68 -> column 7



Sub AddSheet()

    Dim lngSheets As Long
    Dim intCount As Integer
    'copy worksheet
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Unprotect Password:="1111"
    'remove "clear" and "create worksheet" buttons
    ActiveSheet.Shapes.Range(Array("Button 1", "Button 2")).Select
    ActiveSheet.Range("O1:O3").Value = ""
        'remove formulas from worksheet
    With ActiveSheet.UsedRange
        .Value = .Value
    End With
    ' check for multiple tab names, ie BillSmith1, BillSmith2, etc
    For lngSheets = 1 To Sheets.Count
        If Left$(Sheets(lngSheets).Name, Len(Range("P1"))) = Range("P1") Then
            intCount = intCount + 1
        End If
 '   If intCount > 0 Then
        ActiveSheet.Name = Range("P1") & intCount + 1 & "A"
 '   Else
 '       ActiveSheet.Name = Range("P1") & intCount
 '   End If
    'reset password protection
    ActiveSheet.EnableSelection = xlNoSelection
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="1111"
    'Copy over Answer Sheet
    Sheets("Answer Sheet").Select
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Unprotect Password:="1111"
    ' remove formulas
    With ActiveSheet.UsedRange
        .Value = .Value
    End With
    ' clear secondary DISC if not shown
    If ActiveSheet.Range("A17").Value = "" Then
    End If
    ' rename answer sheet
    ActiveSheet.Name = Range("A1") & intCount + 1 & "B"
    ActiveSheet.EnableSelection = xlNoSelection
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="1111"
Question by:bikeski
LVL 18

Accepted Solution

krishnakrkc earned 2000 total points
ID: 40596564

Sub CalcToSummary()
    Dim wksCalc         As Worksheet
    Dim wksSummary      As Worksheet
    Dim v
    Set wksCalc = Worksheets("Calc")
    Set wksSummary = Worksheets("Summary")
    With wksCalc
        v = Array(.Range("p1").Value, .Range("p3").Value, .Range("x71").Value, .Range("x73").Value, _
                .Range("w67").Value, .Range("x67").Value, .Range("w68").Value)
    End With
    wksSummary.Range("a" & wksSummary.Rows.Count).End(3)(2).Resize(, 7).Value = v
End Sub

Open in new window


Author Closing Comment

ID: 40599496
Thanks Kris, worked like a charm. I just added a call to the original VBA code:

Call CalcToSummary()

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are times when I have encountered the need to decompress a response from a PHP request. This is how it's done, but you must have control of the request and you can set the Accept-Encoding header.
A quick solution showing how to control and open a POS Cash Register Drawer using VBA with MS Access.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

564 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question