Excel Macro to Copy a cell from multiple sheets into a Single sheet based on a value

prakashv23

New Member
Joined
Aug 16, 2013
Messages
9
Hi All,

I am new here and am trying to learn VBA, need assistance on a excel report I am creating.
I have an excel document with multiple excel sheets(sheet1, sheet2...etc), now every sheet contains a cell "total".
Now I want to copy the row containing "total" from all the sheets into another sheet called "report".
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Hi And Welcome To the Board

one question in which Column the value total is containing ?
 
Upvote 0
try below code
Code:
Sub Test1()
Dim ws As Worksheet
Dim lr As Long
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "report" Then
        ws.Activate
        lr = Range("D" & Rows.Count).End(xlUp).Row
        For i = 1 To lr
         If Cells(i, 4).Value Like "*total*" Then
          Rows(i).Copy
          Sheets("report").Range("D" & Rows.Count).End(xlUp).Offset(1, -3).PasteSpecial Paste:=xlPasteValues
         End If
         Next
      End If
Next
End Sub
 
Upvote 0
try below code
Code:
Sub Test1()
Dim ws As Worksheet
Dim lr As Long
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "report" Then
        ws.Activate
        lr = Range("D" & Rows.Count).End(xlUp).Row
        For i = 1 To lr
         If Cells(i, 4).Value Like "*total*" Then
          Rows(i).Copy
          Sheets("report").Range("D" & Rows.Count).End(xlUp).Offset(1, -3).PasteSpecial Paste:=xlPasteValues
         End If
         Next
      End If
Next
End Sub

Thanks kevatarvind.
I tried the above macro, I get an error "Subscript Out of Range".

I tried this on a document with sheet1 and sheet 2, both had cell with "total' in column D but one was on row 170 and other on 150.
 
Upvote 0
Thanks kevatarvind.
I tried the above macro, I get an error "Subscript Out of Range".

I tried this on a document with sheet1 and sheet 2, both had cell with "total' in column D but one was on row 170 and other on 150.


My Bad that worked , thanks kevatarvind.

Just another question, does it matter if i change the names of sheets ???

Also, would it be possible that in sheet "reports" ...I know which total came from which sheet ??? i.e = is it possible to prefix the total's in report sheet with sheet name ???
 
Last edited:
Upvote 0
No doesnt matter you can change sheets name just report sheet name should same as in code

And yes you can get sheet name also from which sheet data copied

Right now i am on the way when i will reach home provide u that code
 
Upvote 0
No doesnt matter you can change sheets name just report sheet name should same as in code

And yes you can get sheet name also from which sheet data copied

Right now i am on the way when i will reach home provide u that code

Thanks for the response kevatarvind :).
You have been a great help :pray::pray::pray: and I would await for code(later).
 
Upvote 0
try below code your all sheet name will come in Column A and your data will be paste from Column B onwards

Code:
Sub Test1()
Dim ws As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "report" Then
        ws.Activate
        lr = Range("D" & Rows.Count).End(xlUp).Row
        For i = 1 To lr
         If UCase(Cells(i, 4)) Like "*TOTAL*" Then
          Sheets("report").Range("E" & Rows.Count).End(xlUp).Offset(1, -4).Value = "Copied From WorkSheet-" & ws.Name
          Range(Cells(i, 1), Cells(i, 200)).Copy
          Sheets("report").Range("E" & Rows.Count).End(xlUp).Offset(1, -3).PasteSpecial Paste:=xlPasteValues
         End If
         Next
      End If
Next
Sheets("report").Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0
try below code your all sheet name will come in Column A and your data will be paste from Column B onwards

Code:
Sub Test1()
Dim ws As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "report" Then
        ws.Activate
        lr = Range("D" & Rows.Count).End(xlUp).Row
        For i = 1 To lr
         If UCase(Cells(i, 4)) Like "*TOTAL*" Then
          Sheets("report").Range("E" & Rows.Count).End(xlUp).Offset(1, -4).Value = "Copied From WorkSheet-" & ws.Name
          Range(Cells(i, 1), Cells(i, 200)).Copy
          Sheets("report").Range("E" & Rows.Count).End(xlUp).Offset(1, -3).PasteSpecial Paste:=xlPasteValues
         End If
         Next
      End If
Next
Sheets("report").Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Thanks kevatarvind :)

I tried the above vba, but nothing happens when I run it.
Neither does it throw-up an error nor does it populate the sheet "report".
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top