Copy specific cell values and prepare a summary

[Mr.Karr]

Hello

I have an activity that requires to extract data from particular cells of all available worksheets (value in same cell in all worksheets). For an example: Loan# is by default available in cell G3.

Can anyone please help to copy data this way and paste against the label one by one below?

Please see the attached file.

Many thanks in advance.

 

[Somendra Misra]

Hi Karthik,

Try below code:

Option Explicit

Sub getAllValues()

Dim ws As Worksheet
Dim lastrow As Long

Application.ScreenUpdating = True

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Sheet1" Then
        lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("Sheet1").Cells(lastrow + 1, 1) = ws.Range("G3").Value
        Sheets("Sheet1").Cells(lastrow + 1, 2) = ws.Range("A1").Value
        Sheets("Sheet1").Cells(lastrow + 1, 3) = ws.Range("C4").Value
        Sheets("Sheet1").Cells(lastrow + 1, 4) = ws.Range("C3").Value
        Sheets("Sheet1").Cells(lastrow + 1, 5) = ws.Range("C5").Value
        Sheets("Sheet1").Cells(lastrow + 1, 6) = ws.Range("C5").Value
        Sheets("Sheet1").Cells(lastrow + 1, 7) = ws.Range("A28").Value
        Sheets("Sheet1").Cells(lastrow + 1, 8) = ws.Range("J3").Value
        Sheets("Sheet1").Cells(lastrow + 1, 9) = ws.Range("J4").Value
    End If
Next

Application.ScreenUpdating = False
End Sub

Regards,

 

[Mr.Karr]

Hi Somendra,

Thanks man. You're a rockstar for sure.

If ws.Name <> "Sheet1" Then

Please, incase if i want to ignore "Sheet2" as well. How can i include that here. Please advise.

 

[ayush jain]

Hey, Use this file .. you can increase the number of columns in future as well.. Please make sure the Headers and columns present at sheets match.

Otherwise for short term use Somendra's version.

 

[Somendra Misra]

@Mr.Karr

Try this:

If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" Then

Regards,

 

[Mr.Karr]

@Somendra Misra : a quick question:

If I change the below code:

Sheets("Checklist_Data").Cells(lastrow + 1, 1) = ws.Range("G3").Value

to

Sheets("Checklist_Data").Cells(lastrow + 1, 1) = ws.Range("G3:H25").Value

Will it work? It's not happening man. Can you please help

 

[Mr.Karr]

@ayush jain : thanks for your efforts. I will definitely see your work as well.

 

[Somendra Misra]

@Somendra Misra : a quick question:

If I change the below code:

Sheets("Checklist_Data").Cells(lastrow + 1, 1) = ws.Range("G3").Value

to

Sheets("Checklist_Data").Cells(lastrow + 1, 1) = ws.Range("G3:H25").Value

Will it work? It's not happening man. Can you please help

@Mr.Karr

By that statement you mean one cell get's a value of range that's not possible. May be you should try Copy + Paste like below:

ws.Range("G3:H25").Copy
        Sheets("Checklist_Data").Range("A" & lastrow + 1).PasteSpecial (xlPasteValues)

Regards,

 

[Smallman]

Hi

Consider the following. Note I move the file to the end of the file in line with my code.

Option Explicit

Sub getAllValues2()
Dim i As Integer
Dim j As Integer
Dim ar As Variant

ar = [{"G3", "A1", "C4", "C3", "C5", "C5", "A28", "J3", "J4"}]

    For i = 1 To Worksheets.Count - 1
        For j = 1 To UBound(ar)
            Sheet3.Cells(Rows.Count, j).End(xlUp)(2) = Sheets(i).Range(ar(j))
        Next j
    Next
End Sub

File attached to prove workings.


Take care

Smallman