Loop workbook find and copy data columns

**Alexander Ceed** · 10-21-2010, 05:02 AM

Hi guys,

I have a workbook which contains multiple worksheets. In each worksheet we have different layout (different headers, text, type of formatting etc).

Within each worksheet we have 3 columns with different types of data:

• 1st has exactly 15 characters and ends with either 10 or 01. All numeric
• 2nd has 15 and 16 characters. it always starts TAKI and ends with numeric char.
• 3rd has 6 or 7 characters. All numeric.

These three columns are always next to each other.

Based on the example, is there anyway to automatically search the whole workbook for these 3 types of data and copy them to a new workbook?

Sample workbook with expected result has been added.

Thanks guys.

**snb** · 10-21-2010, 05:47 AM

Sub snb()
  For Each sh In Sheets
    If sh.Name <> "expected" Then
      With sh.Cells.Find("TAKI", , xlValues, xlPart).Offset(, -1)
        Sheets("expected").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.CurrentRegion.Rows.Count, 3).Value = .Resize(.CurrentRegion.Rows.Count, 3).Value
      End With
    End If
  Next
End Sub

**Alexander Ceed** · 10-22-2010, 01:33 AM

Thanks SNB. The code is excelent but I forgot to mention that the data is not contiguous. I updated the sample workbook to see exactly what I mean. It is sperated by a variable range of blank cells.

**snb** · 10-22-2010, 03:00 AM

Sub snb()
  For Each sh In Sheets
    If sh.Name <> "expected" Then
      With sh.UsedRange.Columns(sh.Cells.Find("TAKI11*", , xlValues, xlPart).Column - (Asc(Left(sh.UsedRange.Columns(1).Address(0, 0), 1)) - 65)).Offset(, -1).Resize(, 3)
        .AutoFilter 2, "TAKI11*"
        .Copy Sheets("expected").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .AutoFilter
      End With
    End If
  Next
End Sub