You are here:

Excel/VBA to copy range based on cell value


Hi Tom,

Happy New Year to you. I need help with this problem.

I use a macro in Excel 2007 that extracts data from word tables contained within word files a folder. each folder may contain varying number of word files.Macro works fine. tables are identical. Each table data is is extracted to sing row, one below the other, starting from row 1. For example if the folder contains 200 files there will be 200 rows of data.
When extracted each heading will be in one column and the data in the adjoining column in the same row. For example if there are 50 headings and correspond number of responses,  results in 100 columns of data per row.
The problem is that although the tables are identical, in actual extraction after first 8 columns headings do not align and randomly get shifted. may be due to respondents using return key etc. I use another macro to remove the little squares.
I need a macro than will look for the cell value "Report.No" in each row and copies the following from that row to a master sheet:

1.First 8 column data then
2.Values found in 1st and 3rd adjacent cells in the same row after the cell containing the text value "Report No.".
If the original files had 200 rows and 50 columns, master sheet will have 200 rows and 10 columns.

Thank you for your previous prompt helps!



This worked for me if I understood the situation correctly.  It works on the active sheet. It writes to a sheet name "Master" (which you can change in the code).

Sub ABC()
Dim sh As Worksheet, sh1 As Worksheet, rw1 As Long
Dim r As Range, rr As Range, cell As Range
Set sh = ActiveSheet
Set sh1 = Worksheets("Master")
rw1 = 1
Set r = sh.Range("A1", sh.Cells(sh.Rows.Count, 1).End(xlUp))
For Each cell In r
If Application.CountIf(cell.EntireRow, "*Report No.*") > 0 Then
  res = Application.Match("*Report No.*", sh.Rows(cell.Row), 0)
  cell.Resize(1, 8).Copy sh1.Cells(rw1, 1)
  Set rr = sh.Cells(cell.Row, res)
  sh1.Cells(rw1, 9) = rr.Offset(0, 1)
  sh1.Cells(rw1, 10) = rr.Offset(0, 3)
  rw1 = rw1 + 1
End If
End Sub

Tom Ogilvy  
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts


Tom Ogilvy


Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]


Extensive experience.

Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 All rights reserved.