Excel VB Sripting

Posted on 2013-01-15
Medium Priority
Last Modified: 2013-01-16
Hello people, I have an excel Spreadsheet that has a sheet in an excel workbook named Summary and multiple other sheets (the sheet names can be named different).  what i am looking to accomplish is combing the cells in C9:H44 into the summary sheet.  All the sheets have the same information in them but for instantance sheet 1 would have A's in the above cells Sheet two would have B's and so on.  On the summary sheet it would basically combine the cells using the & function and would be displayed as AB.  I have some sample code that completes this but it only works if the sheets are named what they are in the code. Can i set this up as a varible and have it go through all the sheets.  

thanks in advance.

    ActiveCell.FormulaR1C1 = ""
    ActiveCell.FormulaR1C1 = _
    Selection.AutoFill Destination:=Range("C9:C45"), Type:=xlFillDefault
    Selection.AutoFill Destination:=Range("C9:H45"), Type:=xlFillDefault
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-9
Question by:kkenison
  • 2
LVL 26

Accepted Solution

redmondb earned 2000 total points
ID: 38781041
Hi, kkenison.

Please see attached. The code is...
Option Explicit

Const xRANGE = "C9:H44"

Sub Summarise_Sheets()
Dim i          As Long
Dim j          As Long
Dim xArray_Wrk As Variant
Dim xArray_Out As Variant
Dim xSheet     As Worksheet

xArray_Out = Sheets("Summary").Range(xRANGE)

For Each xSheet In ThisWorkbook.Sheets
    If xSheet.Name <> "Summary" Then
        xArray_Wrk = xSheet.Range(xRANGE)
        For i = 1 To UBound(xArray_Wrk, 1)
            For j = 1 To UBound(xArray_Wrk, 2)
                If xArray_Wrk(i, j) <> "" Then xArray_Out(i, j) = xArray_Out(i, j) & xArray_Wrk(i, j)
    End If

Sheets("Summary").Range(xRANGE) = xArray_Out

End Sub

Open in new window

Edit:Range converted to a constant to make it easier to change.


Author Closing Comment

ID: 38784091
Thank you very much for your help this worked perfectly.
LVL 26

Expert Comment

ID: 38784115
Thanks, kkenison!

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

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

I came across an unsolved Outlook issue and here is my solution.
Currently, there is an issue with being able to copy values from an external application to a dropdown list in Project Web Access (PWA).  The standard copy and paste methods don't seem to work properly. Here is a way to accomplish this task to s…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

580 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