K
kronos
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
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