Excel
Posted by Ron Binder on January 24, 2002 8:03 AM
I have several Excel spreadsheets that I need to consolidate into one spreadsheet each week. The individual spreadsheets vary in length depending on how much information the user's input each week. Today, I select the range to copy from each individual spreadsheet and copy it to the consolidated spreadsheet. I would like to run a Macro that automatically selects the 'used' range (rows 3 to the last used row) & columns (A to M) and excludes the header rows (1 & 2). Does anyone have a Macro or VB code that can do this? Would appreciate any suggestions you might have. Many thanks.
Posted by Mark O'Brien on January 24, 2002 9:54 AM
Some quick and mildly messy codeing could do this. This line of code will select the usedrange, then offset that selection by 2 rows. What this means is that at the end of the selection is two blank rows. If you are only copying this selection to the end of the consolidated file, I don't see this being a problem. I'm sure there's some smart cookie here that would modify the code to trim these two lines off. Anyway, here is the code, I've also assumed that the activesheet is the sheet that is going to be copied.
ActiveSheet.UsedRange.Offset(2, 0).Select
Any problems, just repost.
Posted by Ron on January 25, 2002 12:06 PM
Mark,
The VB code you suggested works, but it gives me the entire active spreadsheet. I found the
attached code in O'Reilly's Excel Macros book which utilizes the UsedRange Function and then
removes the blank lines. Unfortunately, I can't get the function to work in a Macro.
Hope you might have some suggestions. Thanks again for your suggestion and help. It is
greatly appreciated.
Ron
Function GetUsedRange(ws As Worksheet) As Range
' Assumes that Excel's UsedRange gives a superset
' of the real used range.
Dim s As String, x As Integer
Dim rng As Range
Dim r1Fixed As Integer, c1Fixed As Integer
Dim r2Fixed As Integer, c2Fixed As Integer
Dim i As Integer
Dim r1 As Integer, c1 As Integer
Dim r2 As Integer, c2 As Integer
Set GetUsedRange = Nothing
'Start with Excel's used range
Set rng = ws.UsedRange
'Get bounding cells for Excel's used range
'That is, Cells(r1,c1) to Cells(r2,c2)
r1 = rng.Row
r2 = rng.Rows.Count + r1 - 1
c1 = rng.Column
c2 = rng.Columns.Count + c1 - 1
'Save existing values
r1Fixed = r1
c1Fixed = c1
r2Fixed = r2
c2Fixed = c2
'Check rows from top down for all blanks.
'If found, shrink rows.
For i = 1 To r2Fixed - r1Fixed + 1
If Application.CountA(rng.Rows(i)) = 0 Then
'empty row --reduce
r1 = r1 + 1
Else
'nonempty row, get out
Exit For
End If
Next
'Repeat for columns from left to right
For i = 1 To c2Fixed - c1Fixed + 1
If Application.CountA(rng.Columns(i)) = 0 Then
c1 = c1 + 1
Else
Exit For
End If
Next
'Reset the range
Set rng = ws.Range(ws.Cells(r1, c1), ws.Cells(r2, c2))
'Start again
r1Fixed = r1
c1Fixed = c1
r2Fixed = r2
c2Fixed = c2
'Do rows from bottom up
For i = r2Fixed - r1Fixed + 1 To 1 Step -1
If Application.CountA(rng.Rows(i)) = 0 Then
r2 = r2 - 1
Else
Exit For
End If
Next
'Repeat for columns from right to left
For i = c2Fixed - c1Fixed + 1 To 1 Step -1
If Application.CountA(rng.Columns(i)) = 0 Then
c2 = c2 - 1
Else
Exit For
End If
Next
Set GetUsedRange = ws.Range(ws.Cells(r1, c1), ws.Cells(r2, c2))
End Function
Posted by Mark O'Brien on January 25, 2002 1:13 PM
It looks like this code is supposed to go through the usedrange and strips out entire blank rows or columns. I've tried it and it doesn't seem to work. I mean, I get the function to run, but it doesn't seem to do anything at all.
The data that you are looking to copy and paste, does it contain blank rows in it?
