I have encountered a problem during my work.

There are over one hundred worksheets in my excel, and I would like to extract values from certain location (I25:K25, I50:K50, I95:K95) along with the worksheet name on the beside for every worksheet.

I would like to have these extracted values pasted on a new worksheet.

Does anyone know if there is any excel formula or excel macro I could use to achieve the goal?

I'm not proficient with formulas, but it would certainly be doable with VBA.

Look into For Each..Next loops, which I think you should use to go through all sheets.

Next, the .Name property will extract the sheet's name for you. You can save this to a variable and fill a cell with.

Getting values from one cell to another is as easy as

.Sheets(1).Range("A1:B1").Value = .Sheets(2).Range("A1:B1").Value

Note that SO is not a free code writing service, so I won't go as far as writing the entire procedure for you. If you have some code but encounter problems, come back to us.

Useful links:

looping through sheets

Copying cell values

Workbook and -sheet objects

This code loop all sheets except sheet called Results, code sheet name in column A and range values in columns B:D.

Option Explicit

Sub test()

 Dim ws As Worksheet, wsResults As Worksheet
 Dim Lastrow As Long

 With ThisWorkbook

 Set wsResults = .Worksheets("Results")

 For Each ws In .Worksheets
 If ws.Name <> "Results" Then
 Lastrow = wsResults.Cells(wsResults.Rows.Count, "A").End(xlUp).Row
 wsResults.Range("A" & Lastrow + 1 & ":A" & Lastrow + 3).Value = ws.Name
 ws.Range("I25:K25").Copy wsResults.Range("B" & Lastrow + 1)
 ws.Range("I50:K50").Copy wsResults.Range("B" & Lastrow + 2)
 ws.Range("I95:K95").Copy wsResults.Range("B" & Lastrow + 3)
 End If
 Next ws

 End With

End Sub

Ranges to New Master Worksheet

• 
  Workbook
  Download
  (Dropbox)


• Adjust the values in the constants (Const) section to fit your
  needs.


• The code will only affect the workbook containing it.


• The code will delete a possible existing worksheet named after
  cTarget, but will only read from all other worksheets. Then it will
  create a worksheet named after cTarget and write the read data to it.


• To run the code, go to the Developer tab and click Macros and
  click RangesToNewMasterWorksheet.

Sub RangesToNewMasterWorksheet()

 ' List of Source Row Range Addresses
 Const cRowRanges As String = "I25:K25, I50:K50, I95:K95"
 Const cTarget As String = "Result" ' Target Worksheet Name
 Const cHead1 As String = "ID" ' 1st Column Header
 Const cHead2 As String = "Name" ' 2nd Column Header
 Const cHead As Long = 2 ' Number of First Header Columns
 Const cRange As String = "Rng" ' Range (Area) String
 Const cColumn As String = "C" ' Column String
 Const cFirstCell As String = "A1" ' Target First Cell Range Address

 Dim wb As Workbook ' Source/Target Workbook
 Dim ws As Worksheet ' Current Source/Target Worksheet
 Dim rng As Range ' Current Source/Target Range
 Dim vntT As Variant ' Target Array
 Dim vntA As Variant ' Areas Array
 Dim vntR As Variant ' Range Array
 Dim NoA As Long ' Number of Areas
 Dim NocA As Long ' Number of Area Columns (in Target Array)

 Dim i As Long ' Area Counter
 Dim j As Long ' Area Column Counter
 Dim k As Long ' Target Array Row Counter
 Dim m As Long ' Target Array Column Counter

 ' Speed Up.
 With Application
 .ScreenUpdating = False
 .Calculation = xlCalculationManual
 End With

 ' Create a reference to ThisWorkbook i.e. the workbook containing this code.
 Set wb = ThisWorkbook

 ' Task: Delete a possibly existing instance of Target Worksheet.

 Application.DisplayAlerts = False
 On Error Resume Next
 wb.Worksheets(cTarget).Delete
 On Error GoTo 0
 Application.DisplayAlerts = True

 ' Handle unexpected error.
 On Error GoTo UnExpected

 ' Task: Calculate size of Target Array.

 ' Create a reference to the 1st worksheet. (Note: Not sheet.)
 For Each ws In wb.Worksheets
 Exit For
 Next
 ' Create a reference to the Source Row Range (in 1st worksheet.
 Set rng = ws.Range(cRowRanges)
 With rng
 NoA = .Areas.Count
 ReDim vntA(1 To NoA)
 ' Calculate Number of Area Columns (NocA).
 For i = 1 To NoA
 With .Areas(i)
 ' Write number of columns of current Area (i) to Areas Array.
 vntA(i) = .Columns.Count
 NocA = NocA + vntA(i)
 End With
 Next
 End With

 ' Resize Target Array.
 ' Rows: Number of worksheets + 1 for headers.
 ' Columns: Number of First Header Columns + Number of Area Columns.
 ReDim vntT(1 To wb.Worksheets.Count + 1, 1 To cHead + NocA)

 ' Task: Write 'Head' (headers) to Target Array.

 vntT(1, 1) = cHead1
 vntT(1, 2) = cHead2
 k = cHead
 For i = 1 To NoA
 For j = 1 To vntA(i)
 k = k + 1
 vntT(1, k) = cRange & i & cColumn & j
 Next
 Next

 ' Task Write 'Body' (all except headers) to Target Array.

 k = 1
 For Each ws In wb.Worksheets
 k = k + 1
 vntT(k, 1) = k - 1
 vntT(k, 2) = ws.Name
 Set rng = ws.Range(cRowRanges)
 m = cHead
 For i = 1 To NoA
 vntR = rng.Areas(i)
 For j = 1 To vntA(i)
 m = m + 1
 vntT(k, m) = vntR(1, j)
 Next
 Next
 Next

 ' Task: Copy Target Array to Target Worksheet.

 ' Add new worksheet to first tab (1).
 Set ws = wb.Sheets.Add(Before:=wb.Sheets(1))
 ws.Name = cTarget
 ' Calculate Target Range i.e. resize First Cell Range by size of
 ' Target Array.
 Set rng = ws.Range(cFirstCell).Resize(UBound(vntT), UBound(vntT, 2))
 rng = vntT

 ' Task: Apply Formatting.

 ' Apply formatting to Target Range.
 With rng
 .Columns.AutoFit
 ' Apply formatting to Head (first row).
 With .Resize(1)
 .Interior.ColorIndex = 49
 With .Font
 .ColorIndex = 2
 .Bold = True
 End With
 .BorderAround xlContinuous, xlThin
 .Borders(xlInsideVertical).LineStyle = xlContinuous
 End With
 ' Apply formatting to Body (all except the first row).
 With .Resize(rng.Rows.Count - 1).Offset(1)
 .Interior.ColorIndex = xlColorIndexNone
 With .Font
 .ColorIndex = xlColorIndexAutomatic
 .Bold = False
 End With
 .Borders(xlEdgeLeft).LineStyle = xlContinuous
 .Borders(xlEdgeRight).LineStyle = xlContinuous
 .Borders(xlInsideVertical).LineStyle = xlContinuous
 End With
 End With

 MsgBox "The program finished successfully.", vbInformation, "Success"

ProcedureExit:

 ' Speed Down.
 With Application
 .Calculation = xlCalculationAutomatic
 .ScreenUpdating = True
 End With

Exit Sub

UnExpected:
 MsgBox "An unexpected error occurred. Error '" & Err.Number & "': " _
 & Err.Description, vbCritical, "Error"
 GoTo ProcedureExit

End Sub