Results 1 to 4 of 4
  1. #1
    2 Star Lounger
    Join Date
    Oct 2005
    Location
    Cambridgeshire, USA
    Posts
    109
    Thanks
    0
    Thanked 0 Times in 0 Posts

    copying range with unknown number of sheets (excel 2003)

    Hello Everyone,

    I need to create a macro to copy cells A7:K22 and A53:K72 from multiple sheets to a sheet call "recap". I don't know how many sheets I will have in the workbook, but I would like to make sure that all information from all the sheets are copy to the "recap" sheet. I also need to make delete rows if there is nothing in the range above. Any help would be great.

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: copying range with unknown number of sheets (excel 2003)

    I am not sure exactly what you are after. Does this do what you want? Try it on a copy first as it will change the sheet named "Recap".

    <pre>Option Explicit
    Sub CopyRangesToRecap()
    Dim sRange1 As String
    Dim sRange2 As String
    Dim sRecap As String
    Dim wRecap As Worksheet
    Dim wks As Worksheet
    Dim rCopy As Range

    sRecap = "Recap"
    sRange1 = "A7:K22"
    sRange2 = "A53:K72"

    Set wRecap = Worksheets(sRecap)
    For Each wks In ActiveWorkbook.Worksheets
    If UCase(wks.Name) <> UCase(sRecap) Then
    Set rCopy = wRecap.Range("A65536").End(xlUp).Offset(1, 0)
    wks.Range(sRange1).Copy rCopy
    Set rCopy = wRecap.Range("A65536").End(xlUp).Offset(1, 0)
    wks.Range(sRange2).Copy rCopy
    End If
    Next

    Set rCopy = Nothing
    Set wks = Nothing
    Set wRecap = Nothing
    End Sub</pre>


    It does not delete the blank rows within the dataset, but when it adds the new ranges (both within and between sheets) if adds it to the next available row, in case nothing is in the range at the bottom. It keys on the last item in column A, so if this will not always be filled, you may have to use a different column.

    Steve

  3. #3
    2 Star Lounger
    Join Date
    Oct 2005
    Location
    Cambridgeshire, USA
    Posts
    109
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: copying range with unknown number of sheets (excel 2003)

    Thanks Steve, but was I was looking for is to copy the same range for each worksheet and dump it into a running total so I can do a pivot table instread of having to select each sheet. I also need to delete any rows that don't have any information. For example, if a sheet(1) range A7:K22 have any information, I need to copy it into a sheet call recap. This will give me 16 rows of information and then the 17 in the sheet call recap will have the range A53:K72. Sheet (2) will begin in row 37 in the recap sheet and all other will continue. Basically, the recap sheet is a running total of all sheets range a:7K22 and A53:K72. I plan to create a pivot table afterwards to show percentages and other data. I could also select the each range for the pivot table, but it will take to long unless I create a macro. Thanks for any help you can provide.

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: copying range with unknown number of sheets (excel 2003)

    Does this slightly expanded version of Steve's code do what you want?

    Sub CopyRangesToRecap()
    Dim sRange1 As String
    Dim sRange2 As String
    Dim sRecap As String
    Dim wRecap As Worksheet
    Dim wks As Worksheet
    Dim lRow As Long
    Dim lMaxRow As Long
    Dim lCol As Long
    Dim strVal As String

    sRecap = "Recap"
    sRange1 = "A7:K22"
    sRange2 = "A53:K72"

    lRow = 1
    Set wRecap = Worksheets(sRecap)
    For Each wks In ActiveWorkbook.Worksheets
    If UCase(wks.Name) <> UCase(sRecap) Then
    ' Copy first range
    wks.Range(sRange1).Copy wRecap.Range("A" & lRow)
    lRow = lRow + 16
    ' Copy second range
    wks.Range(sRange2).Copy wRecap.Range("A" & lRow)
    lRow = lRow + 20
    End If
    Next

    ' Get last used row
    lMaxRow = wRecap.Cells.Find(What:="*", SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious).Row
    For lRow = lMaxRow To 1 Step -1
    ' Concatenate values
    strVal = ""
    For lCol = 1 To 11
    strVal = strVal & wRecap.Cells(lRow, lCol)
    Next lCol
    ' Delete row if empty
    If strVal = "" Then
    wRecap.Rows(lRow).Delete
    End If
    Next lRow

    Set wks = Nothing
    Set wRecap = Nothing
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •