How do you copy a range?

[thorwood]

Hi, I have the following code which transfers multiple "source" workbooks with a single sheet in each into a single "summary.xls" workbook over multiple sheets.

(1)What I'd like to do is copy a range (B10:O29) instead of the whole sheet...can anyone help? Everything I try gives me unwanted results.

(2)Additionally if its possible to copy each source sheet into the the summary.xls book one after another (i.e all on one sheet, rather than over multiple sheets) that would be ideal, but all I've tried has failed thus far.

Many thanks.


Sub Summarize()

Dim Counter As Long
Dim Source As Workbook
Dim Dest As Workbook

Const Directory As String = "Y:\DB\"

Application.ScreenUpdating = False

For Counter = 1 To 100
Set Source = Workbooks.Open(Directory & Counter & ".xls")
If Counter = 1 Then
Source.Worksheets("DB").Copy
Set Dest = ActiveWorkbook
Else
Source.Worksheets("DB").Copy After:=Dest.Worksheets(Dest.Worksheets.Count)
End If
Source.Close False
Next

Dest.SaveAs Directory & "Summary.xls"

Application.ScreenUpdating = True

MsgBox "Done"

End Sub

 

[OlafBogus]

This copies range (B10:O29) from each sheet in the source book to different rows in the destination "DB" worksheet

Sub Summarize()
'
' Summarize Macro
' by Olaf Bogus
'
    Dim Counter As Long
    Dim Source As Workbook
    Dim Dest As Worksheet
    Dim RowOffset As Integer

    Const Directory As String = "Y:\DB\"

    Application.ScreenUpdating = False
    RowOffset = 0
    Set Dest = ActiveWorkbook.Worksheets("DB")
    
    For Counter = 1 To 100
        Set Source = Workbooks.Open(Directory & Counter & ".xls")
        For Each Worksheet In Source.Worksheets
            Worksheet.Range("B10:O29").Copy
            Dest.Range("B10:O29").Offset(RowOffset, 0).PasteSpecial
            RowOffset = RowOffset + 1
        Next Worksheet
        Source.Close False
    Next

    Dest.SaveAs Directory & "Summary.xls"

    Application.ScreenUpdating = True

    MsgBox "Done"

End Sub

O.B

 

[thorwood]

Hi Olaf

Thanks for that - very helpful.
The only thing is that when trying to run it I get:
"Run time error "9": Subscript out of range" and when debugging it points to the line:
Set Dest = ActiveWorkbook.Worksheets("DB")

DB, by the way, is a folder (not a workbook) - they are numbered 1.xls, 2.xls, 3.xls etc. Is this the problem?

Thanks
Tim

 

[OlafBogus]

Sorry.
Change the

Set Dest = ActiveWorkbook.Worksheets("DB")

to

Set Dest = ActiveWorkbook.Worksheets(1)

O.B

 

[OlafBogus]

Quick modification, this will copy each source book to a new sheet in your destination book.

Sub Summarize()
'
' Summarize Macro
' by Olaf Bogus
'
    Dim Counter As Long
    Dim Source As Workbook
    Dim Dest As Workbook
    Dim DestSheet As Worksheet
    Dim RowOffset As Integer

    Const Directory As String = "Y:\DB\"

    Application.ScreenUpdating = False
    RowOffset = 0
    Set Dest = ActiveWorkbook
    Set DestSheet = ActiveWorkbook.Worksheets(1)
    
    For Counter = 1 To 3
        DestSheet.Name = Counter
        Set Source = Workbooks.Open(Directory & Counter & ".xls")
        For Each Worksheet In Source.Worksheets
            Worksheet.Range("B10:O10").Copy
            DestSheet.Range("B10:O10").Offset(RowOffset, 0).PasteSpecial
            RowOffset = RowOffset + 1
        Next Worksheet
        Dest.Sheets.Add
        Set DestSheet = Dest.ActiveSheet
        Source.Close False
    Next

    Dest.SaveAs Directory & "Summary.xls"

    Application.ScreenUpdating = True

    MsgBox "Done"

End Sub

 

[OlafBogus]

With the last post you would need to reset RowOffset to 0 for each new sheet. I really need more coffee

Sub Summarize()
'
' Summarize Macro
' by Olaf Bogus
'
    Dim Counter As Long
    Dim Source As Workbook
    Dim Dest As Workbook
    Dim DestSheet As Worksheet
    Dim RowOffset As Integer

    Const Directory As String = "Y:\DB\"

    Application.ScreenUpdating = False
    Set Dest = ActiveWorkbook
    Set DestSheet = ActiveWorkbook.Worksheets(1)
    
    For Counter = 1 To 3
        DestSheet.Name = Counter
        RowOffset = 0
        Set Source = Workbooks.Open(Directory & Counter & ".xls")
        For Each Worksheet In Source.Worksheets
            Worksheet.Range("B10:O10").Copy
            DestSheet.Range("B10:O10").Offset(RowOffset, 0).PasteSpecial
            RowOffset = RowOffset + 1
        Next Worksheet
        Dest.Sheets.Add
        Set DestSheet = Dest.ActiveSheet
        Source.Close False
    Next

    Dest.SaveAs Directory & "Summary.xls"

    Application.ScreenUpdating = True

    MsgBox "Done"

End Sub

 

[thorwood]

Thankyou very much for your time and help, much appreciated!!
I shall take a look at this in a few minutes.
Many thanks
Tim

 

[SkipVought]

Hi,

Here's another take on accumulating all the data into one sheet. You might want to consider tagging each pasted section with a new column value in order to differentiate between sources.

Sub Summarize()

    Dim Counter As Long
    Dim Source As Workbook
    Dim Dest As Worksheet

    Const Directory As String = "Y:\DB\"

    Application.ScreenUpdating = False
    Set Dest = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)

    For Counter = 1 To 100
        Set Source = Workbooks.Open(Directory & Counter & ".xls")
'            Source.Worksheets("DB").Copy After:=Dest.Worksheets(Dest.Worksheets.Count)
        Source.Worksheets("DB").Range ("B10:O29"), Copy
        With Dest
            .Cells(.[A1].CurrentRegion.Rows.Count + 1, 1).PasteSpecial xlPasteAll
        End With
        Source.Close False
    Next

    Dest.SaveAs Directory & "Summary.xls"

    Application.ScreenUpdating = True

    MsgBox "Done"

End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[thorwood]

Thanks Skip!

Unfortunately I'm getting the following error when trying to run...

runtime error '438'
"object doesn't support this property or method"

when debugging, its this line....
Source.Worksheets("DB").Range ("B10:O29"), Copy

Any ideas? should I maybe use the full address of DB?

Thanks
Tim

 

[thorwood]

Sorry - ignore that - I just noticed a comma instead of a full stop!! Corrected now and it works - fantastic. Thank you!!!