Open and copy/paste data to same row...

[ReneY]

Hi everyone,

I'm fairly new to VBA and I'm trying to write a code, but I'm totally stuck.
I need to write a code that goes to a specific folder, opens each of the excel files that are in that folder (name and number of the files in that folder change monthly) copy specific cells from each file (file format is exactly the same, it's a template, cells to be copied are always: P5, I2, O3, E2 and Q41) and place them all in a file (Called "Monthly report"), all arranged in the same row, together with the name of the file they were taken from. Then go again to the folder with the files, open the next file and copy the same cells and arrange them next row down in the monthly report file and so on....

I know I have to rewrite it, but I ran out of ideas....I have something like this



Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch


.LookIn = "C:\Documents and Settings\ryanezga\Desktop\Files Rene\Macros\Files FG\ordered via"
.FileType = msoFileTypeExcelWorkbooks



If .Execute > 0 Then

For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)


wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True


ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\ryanezga\Desktop\Files Rene\Macros\Files FG\ordered via\Monthly Report.xls"

I simply have no idea how to ask the program to select/copy specific cells from each file AND paste them in one single row without making the longest code ever and taking the program hours to do it (there's approximately 400-500 files in that folder monthly) so i could technically make a program that goes back and forth from the original file to the monthly report copy/pasting each bit of info and then try to make a loop, but I'm guessing it would run out of memory...

Any suggestions? I don't know what you think, but it's quite complicated... I must admit its way out of my knowledge to do all this in a simple manner... but the boss is the boss, its either that or copy/pasting them myself!

I appreciate your help!

ReneY

[Bob Phillips]

Untested



Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim NextLine as long


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
Set wbCodeBook = Workbooks("Monthly Report")
With Application.FileSearch
.NewSearch


.LookIn = "C:\Documents and Settings\ryanezga\Desktop\Files Rene\Macros\Files FG\ordered via"
.FileType = msoFileTypeExcelWorkbooks



If .Execute > 0 Then

For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

NextLine = NextLine + 1
wbCodeBook.Worksheets(1).Cells(NextLine,"A").Value = wbResults.Worksheets(1).Range("P5").Worksheets(1).Value
wbCodeBook.Worksheets(1).Cells(NextLine,"B").Value = wbResults.Worksheets(1).Range("I2").Worksheets(1).Value
wbCodeBook.Worksheets(1).Cells(NextLine,"C").Value = wbResults.Worksheets(1).Range("O3").Worksheets(1).Value
wbCodeBook.Worksheets(1).Cells(NextLine,"D").Value = wbResults.Worksheets(1).Range("E2").Worksheets(1).Value
wbCodeBook.Worksheets(1).Cells(NextLine,"E").Value = wbResults.Worksheets(1).Range("Q41").Worksheets(1).Value

wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True


wbCodeBook.SaveAs Filename:= _
"C:\Documents and Settings\ryanezga\Desktop\Files Rene\Macros\Files FG\ordered via\Monthly Report.xls"

[ReneY]

Thank you very much!
It keeps marking me there's an "Object Variable or With block variable not set"... still looks much more logical than mine but I cant still make it work

[Bob Phillips]

On what line?

[ReneY]

Sorry, forgot to mention that ...

The line is:

"wbCodeBook.SaveAs Filename:= _
"C:\Documents and Settings\ryanezga\Desktop\Files Rene\Macros\Files FG\ordered via\Monthly Report.xls" "

[Bob Phillips]

There si some code earlier that is setting wbCodeBook



Set wbCodeBook = Workbooks("Monthly Report")


but that is preceded by an On Error Resume Next, so that line might be failing but not reporting an error. Move the On Error line down below that and see what you get.

[ReneY]

mmmm now it marks "subscript out of range" on the line:

"Set wbCodeBook = Workbooks("Monthly Report")"

Don't know what is wrong... tried all different combinations I could think of, so frustrating!

[Bob Phillips]

That means that you don't have a workbbok called 'Monthly Report' open.