Loop a code to copy cells from multiple books&sheets and paste every sheet on every other row in master w.book

[Kakkmaddafakka]

I have a folder with apprx. 1000 w.books (.xls) with eight sheets in each. All books and sheets are identical, however I only need to copy cells from three (3) sheets which all have the same name in all the w.books. I want to copy specific cells from each of the three sheets in every book and into a master book (again, same cells for all three sheets).

I have three problems/questions:

1) How to copy from three sheets in a book, and paste every sheet output in every other row in the master book.
2) How to make a loop to do this for all books and naturally paste sheet#1 from book#2 under sheet#3 from book#1 etc...
3) How to extract the names of the files/w.books and paste it on the same row (e.g. A1,A2,..An) as the information from the file/w.book

I have made a code that copies all the information I need from all three sheets, however, it only paste the information in a specific cell(s), meaning a specific row of the master book; Sheet #1 is pasted in row 3, #2 in 4, and #3 in row 5, but I understand that the code needs to be altered in order for the "every other row"-function and loop to work!?


FYI: (sheet#1 in book#1 needs to start in row 3...)

Here is what I got so far code (at the moment not working):

Sub Test1_0()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook


Application.ScreenUpdating = False


On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "H:\Motor database\EIAPP test"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
.Filename = "*.xls"
If .Execute > 0 Then 'Workbooks in folder
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)


'START OF CODE

''''SHEET 1 - E2 TEST CYCLE'''
'''operation 1 - engine specific
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E2 Test Cycle").Select
Workbooks(wbResults).Sheets("E2 Test Cycle").Range("D5:D9").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("C3").Select
'Special; 90 degree flip
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=True, Transpose:=True
'''end of 1

'''operation 2 - fuel content
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E2 Test Cycle").Select
Workbooks(wbResults).Sheets("E2 Test Cycle").Range("d14:d18").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("i3").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=True
'''End of 2

'''operation 3 - engine power
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E2 Test Cycle").Select
Workbooks(wbResults).Sheets("E2 Test Cycle").Range("e25:h25").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("n3").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 3

'''operation 4 - engine speed
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E2 Test Cycle").Select
Workbooks(wbResults).Sheets("E2 Test Cycle").Range("e26:h26").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("s3").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 4

'''operation 5 - SFOC
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E2 Test Cycle").Select
Workbooks(wbResults).Sheets("E2 Test Cycle").Range("e26:h26").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("ac3").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 4
''''E2 TEST CYCLE END'''


''''SHEET 2 - E3 TEST CYCLE'''
'''operation 1 - engine specific
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E3 Test Cycle ").Select
Workbooks(wbResults).Sheets("E3 Test Cycle ").Range("D5:D9").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("C4").Select
'Special; 90 degree flip
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=True, Transpose:=True
'''end of 1

'''operation 2 - fuel content
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E3 Test Cycle ").Select
Workbooks(wbResults).Sheets("E3 Test Cycle ").Range("d14:d18").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("i4").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=True
'''End of 2

'''operation 3 - engine power
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E3 Test Cycle ").Select
Workbooks(wbResults).Sheets("E3 Test Cycle ").Range("e25:h25").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("n4").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 3

'''operation 4 - engine speed
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E3 Test Cycle ").Select
Workbooks(wbResults).Sheets("E3 Test Cycle ").Range("e26:h26").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("s4").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 4

'''operation 5 - SFOC
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("E3 Test Cycle ").Select
Workbooks(wbResults).Sheets("E3 Test Cycle ").Range("e26:h26").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("ac4").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 4
''''E3 TEST CYCLE END'''


''''SHEET 3 - D2 TEST CYCLE'''
'''operation 1 - engine specific
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("D2 Test Cycle").Select
Workbooks(wbResults).Sheets("D2 Test Cycle").Range("D5:D9").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("C5").Select
'Special; 90 degree flip
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=True, Transpose:=True
'''end of 1

'''operation 2 - fuel content
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("D2 Test Cycle").Select
Workbooks(wbResults).Sheets("D2 Test Cycle").Range("d14:d18").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("i5").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=True
'''End of 2

'''operation 3 - engine power
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("D2 Test Cycle").Select
Workbooks(wbResults).Sheets("D2 Test Cycle").Range("e25:h25").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("n5").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 3

'''operation 4 - engine speed
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("D2 Test Cycle").Select
Workbooks(wbResults).Sheets("D2 Test Cycle").Range("e26:h26").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("s5").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 4

'''operation 5 - SFOC
Workbooks(wbResults).Activate
Workbooks(wbResults).Sheets("D2 Test Cycle").Select
Workbooks(wbResults).Sheets("D2 Test Cycle").Range("e26:h26").Select
Selection.Copy
ThisWorkbook.Activate
Sheets("Engine database").Select
Sheets("Engine database").Range("ac5").Select
Selection.PasteSpecial 12, Operation:=1, SkipBlanks:=False, Transpose:=False
'''End of 4
''''D2 TEST CYCLE END'''

'''END OF CODE

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

End Sub

----
Any contributions to the solution of my problem will be highly appreciated!

 

[JLGWhiz]

I did not test this, so you should run a test on it before running it in your original workbook.

Code:
Sub Test1_0Rev()
Dim lCount As Long, lr As Long
Dim wbResults As Workbook, sh As Variant
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "H:\Motor database\EIAPP test"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
.Filename = "*.xls"
If .Execute > 0 Then 'Workbooks in folder
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)
sh = Array("E2 Test Cycle", "E3 Test Cycle", "D2 Test Cycle")
For i = LBound(sh) To UBound(sh)
lr = wbCodeBook.Cells(Rows.Count, 4).End(xlUp).Row + 1
If lr < 3 Then lr = 3
With sh(i)
.Range("D5:D9").Copy
wbCodeBook.Range("C" & lr).PasteSpecial 12, Operation:=1, SkipBlanks:=True, Transpose:=True
.Range("D14:D18").Copy
wbCodeBook.Range("I" & lr).PasteSpecial 12, Operation:=1, SkipBlanks:=True, Transpose:=True
.Range("E25:H25").Copy wbCodeBook.Range("N" & lr)
.Range("E26:H26").Copy wbCodeBook.Range("S" & lr)
.Range("E26:H26").Copy wbCodeBook.Range("AC" & lr)
End With
Next
Next
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Code:

 

[Kakkmaddafakka]

It does not seem to work. I have tried it in a new book, but when I run it nothing happens; no actions nor any errors. I must admit I am not very good with VBA and am thereby so far not able to fix it. Any suggestions?

 

[JLGWhiz]

It does not seem to work. I have tried it in a new book, but when I run it nothing happens; no actions nor any errors. I must admit I am not very good with VBA and am thereby so far not able to fix it. Any suggestions?

Hi Kakkmaddafakka, I am running xl2007 which has the FileSearch and FoundFiles features disabled, so I am unable to troubleshoot and debug the code. Maybe somebody else with more VBA skill than I have can take a look and help resolve the problem.

Regards, JLG

 

[Kakkmaddafakka]

JLG! Thanks for the effort anyway, and with a little tweak to the code it might just work. Either way I highly appreciate your help! In the meantime waiting for someone else to look at this, I will post this in another forum also. I am kind of in a rush..

Thanks and have a great day/night!

Regards,
KMF

 

[Kakkmaddafakka]

Problem has been SOLVED here:
Loop a code to copy cells from multiple books&sheets and paste in master book (VBA)