Copy information from a specific range; not the entire worksheet.

[Paul]

I found the macro below on this site, and it is just what I've been
looking for. But... I need one modification, and would appreciate if
you could help me.

The macro below copy information starting in cell A5. I need the macro
to copy all information in the range B5:C??? only, and not from all
other columns in each sheet. The sign ??? is the last row used in each
sheet.


Sub CombineSheets()
Dim counter As Long
Dim i As Integer
Dim copyrange As Range
Dim actsheet As Worksheet
Dim sh As Worksheet
Set actsheet = Worksheets("Master")
counter = 2
actsheet.Cells.ClearContents

For i = 2 To ThisWorkbook.Sheets.Count - 1
Set sh = Worksheets(i)
Set rng = Nothing
On Error Resume Next
Set rng = sh.Range("A5").SpecialCells(xlCellTypeLastCell)
On Error GoTo 0
If Not rng Is Nothing Then
Set copyrange = Range(sh.Range("A5"), rng)
If Rows.Count - counter + 1 > copyrange.Rows.Count Then
copyrange.Copy _
actsheet.Cells(counter, 1)
counter = counter + copyrange.Rows.Count
Else
MsgBox "Note enough room"
End If
End If
Next i
End Sub

 

[Don Guillett]

Set rng = sh.Range("A5").SpecialCells(xlCellTypeLastCell)

Is this what you mean?
x=inputbox("enter last row")
or
x=cells(65536,"c")
setrng=sh.range("b5:c"&x)

 

[Paul Oos]

Thx for your reply. The macro should autmatically pick up the last row
used in column C.

I've tried what you suggested but it didn't work; probably my fault.

Shouldn't I do something with this line:
Set rng = sh.Range("A5").SpecialCells(xlCellTypeLastCell)


Paul

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Don Guillett]

Tell us exactly what you are trying to do.

 

[Paul Oos]

I want a macro that copy information from the seccond sheet including
the last but one, and only from the fifth row in columnd B and C
including the last row used in those two columns

Note that all sheets contains information in other columns than B and C.

The macro I specified copy data in all columns used, and I do not know
how to restrict the range to copy.

Paul



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Tom Ogilvy]

Sub CombineSheets()
Dim counter As Long
Dim i As Integer
Dim copyrange As Range
Dim actsheet As Worksheet
Dim sh As Worksheet
Set actsheet = Worksheets("Master")
counter = 2
actsheet.Cells.ClearContents

For i = 2 To ThisWorkbook.Sheets.Count - 1
Set sh = Worksheets(i)
Set rng = Nothing
On Error Resume Next
Set rng = sh.cells(row.count,3).End(xlup)
On Error GoTo 0
If Not rng Is Nothing Then
Set copyrange = sh.Range(sh.Range("B5"), rng)
If Rows.Count - counter + 1 > copyrange.Rows.Count Then
copyrange.Copy _
actsheet.Cells(counter, 1)
counter = counter + copyrange.Rows.Count
Else
MsgBox "Note enough room"
End If
End If
Next i
End Sub

 

[Paul Oos]

Hi Tom,
and thx for your answer. But unfortunately it don't work; nothing occur
when I run your modified macro. I've spent some time to make out how
this macro works, but since I'm not into programming I don't know what's
wrong. But it may be something with the line (or something else that's
connected to it):

Set rng = sh.cells(row.count,3).End(xlup)

'cause when I write nonsense like

Set rng = sh.cells(row.cAAAount,AAA3).End(xlAAAup)

I don't get any errormessage at all.

Paul



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Don Guillett]

try rowS.count

 

[Paul Oos]

Yeah....

Finaly, it works.



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Tom Ogilvy]

Sorry for the Typo.

Your On Error Resume Next statement left over from using specialcells hides
the error - double jeopardy.