copying range with unknown number of sheets (excel 2003)

Topic

New Reply

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.

Reply | Quote

Replies

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”.

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

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

Reply | Quote

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.

Reply | Quote

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

Reply | Quote