christianhau
09-01-2008, 06:28 AM
Hi!
I am trying to write a vba macro that loops through a folder of workbooks and copies some information from each workbook (Sheet1), to a master workbook that should have all the infor from the other workbooks. I am not receiving any error messages but I am not getting any results either so i am kind of stuck, I would appreciate any help! I try to write to the files with the "Test" string but I can only write it to the source files and not to the master file that I am trying to add the information to...
Sub Merge()
Dim i As Integer
Dim Source As Workbook
Dim Destination As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set Destination = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\Documents and Settings\nochhau\Desktop\Excelprosjekt"
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'Workbooks in folder
For i = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set Source = Workbooks.Open(.FoundFiles(i))
Cells(3, 4).Value = "TEST"
Source.Range("A1").Select
Selection.Copy
Destination.Activate
Destination.Range("A1").Select
Cells(3, 4).Value = "TEST"
Selection.Paste
'Source.Close
Next i
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CutCopyMode = False
End Sub
I am trying to write a vba macro that loops through a folder of workbooks and copies some information from each workbook (Sheet1), to a master workbook that should have all the infor from the other workbooks. I am not receiving any error messages but I am not getting any results either so i am kind of stuck, I would appreciate any help! I try to write to the files with the "Test" string but I can only write it to the source files and not to the master file that I am trying to add the information to...
Sub Merge()
Dim i As Integer
Dim Source As Workbook
Dim Destination As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set Destination = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\Documents and Settings\nochhau\Desktop\Excelprosjekt"
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'Workbooks in folder
For i = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set Source = Workbooks.Open(.FoundFiles(i))
Cells(3, 4).Value = "TEST"
Source.Range("A1").Select
Selection.Copy
Destination.Activate
Destination.Range("A1").Select
Cells(3, 4).Value = "TEST"
Selection.Paste
'Source.Close
Next i
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.CutCopyMode = False
End Sub