Copy cells from other workbooks
 

Hi all,
could somebody take a look on the macro below?

This macro takes a specified range (a1:c5) of the first worksheet from all
workbooks that are in a given folder (C:\Data) and copy it to the first
worksheet of my workbook. Seems fine...
However, there is a problem if I want to save the macro in the
"Personal.xls" (so it's accesible to all workbooks) - in this case, the
macro will paste all retrieved data to the first worksheet of my
"Personal.xls" file (that is normally kept hidden). Which lines should be
modified in order to put all retrieved information to the "normal" workbook?
Any ideas?

And, by the way, is there any possibility to indicate that the macro should
take into account workbooks that not only are in a specific folder (f. ex.
C:\Data), but also have the same beginning of their name (f. ex.
"mam*.xls").

Thanks a lot for any comments!
Cheers,

* * *

Sub CopyRange()

Dim basebook As Workbook

Dim mybook As Workbook

Dim sourceRange As Range

Dim destrange As Range

Dim rnum As Long

Dim i As Long

Dim a As Long

Application.ScreenUpdating = False

With Application.FileSearch

.NewSearch

.LookIn = "C:\Data"

.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

Set basebook = ThisWorkbook

rnum = 1

For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Range("a1:c5")

a = sourceRange.Rows.Count

Set destrange = basebook.Worksheets(1).Cells(rnum, 1)

sourceRange.Copy destrange

mybook.Close

rnum = i * a + 1

Next i

End If

End With

Application.ScreenUpdating = True

End Sub



Sub CopyRangeValues()

Dim basebook As Workbook

Dim mybook As Workbook

Dim sourceRange As Range

Dim destrange As Range

Dim rnum As Long

Dim i As Long

Dim a As Long

Application.ScreenUpdating = False

With Application.FileSearch

.NewSearch

.LookIn = "C:\Data"

.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

Set basebook = ThisWorkbook

rnum = 1

For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Range("a1:c5")

a = sourceRange.Rows.Count

With sourceRange

Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _

Resize(.Rows.Count, .Columns.Count)

End With

destrange.Value = sourceRange.Value

mybook.Close

rnum = i * a + 1

Next i

End If

End With

Application.ScreenUpdating = True

End Sub

Copy cells from other workbooks
 

Hi

Set basebook = ThisWorkbook
change to
Set basebook = Activeworkbook


For 2
http://www.rondebruin.nl/copy3.htm#range2

--
Regards Ron de Bruin
http://www.rondebruin.nl


"kronos" wrote in message ...
Hi all,
could somebody take a look on the macro below?

This macro takes a specified range (a1:c5) of the first worksheet from all
workbooks that are in a given folder (C:\Data) and copy it to the first
worksheet of my workbook. Seems fine...
However, there is a problem if I want to save the macro in the
"Personal.xls" (so it's accesible to all workbooks) - in this case, the
macro will paste all retrieved data to the first worksheet of my
"Personal.xls" file (that is normally kept hidden). Which lines should be
modified in order to put all retrieved information to the "normal" workbook?
Any ideas?

And, by the way, is there any possibility to indicate that the macro should
take into account workbooks that not only are in a specific folder (f. ex.
C:\Data), but also have the same beginning of their name (f. ex.
"mam*.xls").

Thanks a lot for any comments!
Cheers,

* * *

Sub CopyRange()

Dim basebook As Workbook

Dim mybook As Workbook

Dim sourceRange As Range

Dim destrange As Range

Dim rnum As Long

Dim i As Long

Dim a As Long

Application.ScreenUpdating = False

With Application.FileSearch

.NewSearch

.LookIn = "C:\Data"

.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

Set basebook = ThisWorkbook

rnum = 1

For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Range("a1:c5")

a = sourceRange.Rows.Count

Set destrange = basebook.Worksheets(1).Cells(rnum, 1)

sourceRange.Copy destrange

mybook.Close

rnum = i * a + 1

Next i

End If

End With

Application.ScreenUpdating = True

End Sub



Sub CopyRangeValues()

Dim basebook As Workbook

Dim mybook As Workbook

Dim sourceRange As Range

Dim destrange As Range

Dim rnum As Long

Dim i As Long

Dim a As Long

Application.ScreenUpdating = False

With Application.FileSearch

.NewSearch

.LookIn = "C:\Data"

.SearchSubFolders = False

.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then

Set basebook = ThisWorkbook

rnum = 1

For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))

Set sourceRange = mybook.Worksheets(1).Range("a1:c5")

a = sourceRange.Rows.Count

With sourceRange

Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _

Resize(.Rows.Count, .Columns.Count)

End With

destrange.Value = sourceRange.Value

mybook.Close

rnum = i * a + 1

Next i

End If

End With

Application.ScreenUpdating = True

End Sub