Snasui Excel Forum

Code: Select all

Sub findFR()
Dim a As Range, o As Range, r As Range
Dim i As Integer

For i = 2 To Sheets.Count
        Sheets(i).Select
        
    a = Range.Find(What:="ลำดับ", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows + 1, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False)
   
    r = Range(a).End(xlUp).Row
        Range("a:" & (cell(a, 15).Range)).Copy
        Sheets(1).Select
        
        Range("a" & Rows.Count + 1).PasteSpecial
Next i
End Sub

Code: Select all

Dim rs As Range, c As Range
Dim i As Integer
Dim sh As Worksheet
For Each sh In Worksheets
    If sh.Name <> "Sheet1" Then
        Set c = sh.Cells.Find(What:="ÅӴѺ", LookIn:=xlValues).Offset(1, 0)
        If Not c Is Nothing Then
            Set rs = sh.Range(c, sh.Cells(sh.Rows.Count, c.Column).End(xlUp))
            i = rs.Rows.Count
            With Worksheets("Sheet1")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .Resize(i, 15).Value = rs.Resize(, 15).Value
            End With
        End If
    End If
Next sh

Code: Select all

Dim rs As Range, c As Range, o As Range
Dim i As Integer, e As Integer
Dim sh As Worksheet
For Each sh In Worksheets
    If sh.Name <> "Sheet1" Then
        Set c = sh.Cells.Find(What:="ÅӴѺ", LookIn:=xlValues).Offset(1, 0)
        Set o = sh.Cells.Find(What:="ÃËÑÊÊÒ¢Ò", LookIn:=xlValues)
        If o.Value = "ÃËÑÊÊÒ¢Ò" Then
            If Not c Is Nothing Then
                Set rs = sh.Range(c, sh.Cells(sh.Rows.Count, c.Column).End(xlUp))
                i = rs.Rows.Count
                With Worksheets("Sheet1")
                    .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                        .Resize(i, 15).Value = rs.Resize(, 15).Value
                    .Range("p" & .Rows.Count).End(xlUp).Offset(1, 0) _
                        .Resize(i, 1).Value = o.Offset(0, 1).Value
                End With
            End If
        End If
    End If
Next sh

Code: Select all

Dim rs As Range, c As Range, o As Range
Dim i As Integer, e As Integer
Dim sh As Worksheet
For Each sh In Worksheets
    If sh.Name <> "Sheet1" Then
        Set c = sh.Cells.Find(What:="ÅӴѺ", LookIn:=xlValues).Offset(1, 0)
        Set o = sh.Cells.Find(What:="ÃËÑÊÊÒ¢Ò", LookIn:=xlValues)
        If Not c Is Nothing Then
            Set rs = sh.Range(c, sh.Cells(sh.Rows.Count, c.Column).End(xlUp))
            i = rs.Rows.Count
            With Worksheets("Sheet1")
                .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .Resize(i, 15).Value = rs.Resize(, 15).Value
                If o.Value = "ÃËÑÊÊÒ¢Ò" Then
                    .Range("p" & .Rows.Count).End(xlUp).Offset(1, 0) _
                        .Resize(i, 1).Value = o.Offset(0, 1).Value
                End If
            End With
        End If
    End If
Next sh