MACROS - complex operation for summarising lots of sheets into one data base

[LitoII]

Hello, guys. I need to write a code in visual basic for a complex macro, executing the following commands:

There is a workbook with approx. 150 sheets, each sheet being a dossier of a firm, so it is needed a table in another sheet (named 'table') to be made that would summarise all the other sheets. The names of the sheets are listed from A2 to A153 and the details, it is asked for from the dossiers, are on the first row.


The cursor is in B2.
1. The macros shall go to the sheet, which name is in the cell in the A column on the same row (in this situation: A2).
2. There it shall look up for the word 'Base index:' (which will also be in the B1 cell of the 'table' sheet).
3. Then it shall copy the information from the C column of the same raw ('Base index:' is in the B column and is available in each sheet, but in a different row).
4. Afterwards, it shall paste it in the B2 cell in the 'table' sheet.

Then the cursor shall go to cell B3 of the 'table' sheet and the macros shall execute the very same operation: go to the sheet, which name stands in the A3 cell, look up where the information for the 'Base index' is, copy it and paste it in this B3 cell.

And so until B153.

Then the cursor shall return to the C2 cell of the 'table' sheet and the macros shall execute a very similar operation:
1. The macros shall go to the sheet, which name is in the cell in the A column on the same row (in this situation: A2).
2. There it shall look up for the word 'A300' (which will also be in the C1 cell of the 'table' sheet).
3. Then it shall copy the information from the C column of the same raw ('A300' is in the B column and is only available in some sheets).
4. Afterwards, it shall paste it in the C2 cell in the 'table' sheet.
(I underlined the differences with the first action)

It shall continue the operation for every single column (I still don't know how many of them they will be, but most probably they will go at least to EH column).



If you could help me even with part of the code, I would appreciate it a lot, as I realise it is far from a basic one :/

 

[LitoII]

This is the code I was looking for : )

Sub LitoIIa()


Dim p_name As String ' must be entered from ....
Dim x As Integer
Dim sh_name As String, cur_sh_name As String
Dim ws As Worksheet
Dim c1 As Variant


p_name = InputBox("Key word:", "Book search macro", "Enter your keyword here", 500, 700)


Sheets("_Listed Sheets").Select
Set ws = ActiveSheet


Sheets("_Answers").Select
Range("b1").Activate
Sheets(ws.Name).Select
Range("a1").Activate
While (ActiveCell.Value) <> 0


sh_name = ActiveCell.Value
Sheets(sh_name).Select
Range("A1").Select
Set c1 = Cells.Find(What:=p_name, Lookat:=xlWhole)

If Not c1 Is Nothing Then
c1.Offset(0, 1).Range("A1:B1").Copy
Sheets("_Answers").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -1).Value = sh_name
ActiveCell.Offset(1, 0).Activate
End If

Sheets(ws.Name).Select
ActiveCell.Offset(1, 0).Activate


Wend


Sheets("_Answers").Select


End Sub