Snasui Excel Forum

Code: Select all

Sub searchMultiplesheets()
    Dim r As Range, t As Range
    Dim ws As Worksheet, i As Integer, s As String
    With Sheets(1)
        s = .Range("c1").Value
        .Range("a3").Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    End With
    For Each ws In Worksheets
    If ws.Name <> Sheets(1).Name Then
        With ws
            For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
                If r.Value & r.Offset(0, 1).Value & _
                    r.Offset(0, 2).Value & r.Offset(0, 3).Value Like "*" & s & "*" Then
                    With Sheets(1)
                        Set t = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                            .Resize(1, 4)
                        r.Resize(1, 4).Copy t
                    End With
                    Application.CutCopyMode = False
                End If
            Next r
        End With
    End If
    Next ws
End Sub

Code: Select all

'Other code
With ws
    For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        If r.Value & r.Offset(0, 1).Value & r.Offset(0, 2).Value & r.Offset(0, 3).Value & _
        r.Offset(0, 4).Value & r.Offset(0, 5).Value & r.Offset(0, 5).Value & _
        r.Offset(0, 6).Value & r.Offset(0, 7).Value & r.Offset(0, 8).Value & _
        r.Offset(0, 9).Value Like "*" & s & "*" Then
            With Sheets(1)
                Set t = .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 10)
                r.Resize(1, 10).Copy t
            End With
            Application.CutCopyMode = False
        End If
    Next r
End With

'Other code

Code: Select all

Private Sub sv_Click()

If Range("f4") = "Import" Then
    i = WorksheetFunction.CountA(Worksheets("data").Columns("D:D")) + 1
    Worksheets("data").Cells(i, 2).Value = Range("c4").Value
    Worksheets("data").Cells(i, 3).Value = Range("c5").Value
    Worksheets("data").Cells(i, 4).Value = Range("c6").Value
    Worksheets("data").Cells(i, 5).Value = Range("c7").Value
    Worksheets("data").Cells(i, 6).Value = Range("d7").Value
    Worksheets("data").Cells(i, 7).Value = Range("f7").Value
    Worksheets("data").Cells(i, 8).Value = Range("f5").Value
    Worksheets("data").Cells(i, 9).Value = Range("f4").Value
    Worksheets("data").Cells(i, 10).Value = Range("c8").Value
 Else

    If Range("f4") = "Export" Then
    If Not Worksheets("data2").Columns("G:G").Find(Range("c7"), LookIn:=xlValues) Is Nothing Then
    
    MsgBox "same number can't save"
   
    Else
    i = WorksheetFunction.CountA(Worksheets("data2").Columns("D:D")) + 1
    Worksheets("data2").Cells(i, 2).Value = Range("c4").Value
    Worksheets("data2").Cells(i, 3).Value = Range("c5").Value
    Worksheets("data2").Cells(i, 4).Value = Range("c6").Value
    Worksheets("data2").Cells(i, 5).Value = Range("c7").Value
    Worksheets("data2").Cells(i, 6).Value = Range("d7").Value
    Worksheets("data2").Cells(i, 7).Value = Range("f7").Value
    Worksheets("data2").Cells(i, 8).Value = Range("f5").Value
    Worksheets("data2").Cells(i, 9).Value = Range("f4").Value
    Worksheets("data2").Cells(i, 10).Value = Range("c8").Value
    End If
    End If
End If
        ThisWorkbook.Sheets("Index").Hyperlinks.Add Anchor:=Range("C8"), Address:= _
        Range("C8").Value, TextToDisplay:=Range("C8").Value
End Sub

Code: Select all

Private Sub sv_Click()
If Range("f4") = "Import" Then
    i = WorksheetFunction.CountA(Worksheets("data").Columns("D:D")) + 1
    Worksheets("data").Cells(i, 2).Value = Range("c4").Value
    Worksheets("data").Cells(i, 3).Value = Range("c5").Value
    Worksheets("data").Cells(i, 4).Value = Range("c6").Value
    Worksheets("data").Cells(i, 5).Value = Range("c7").Value
    Worksheets("data").Cells(i, 6).Value = Range("d7").Value
    Worksheets("data").Cells(i, 7).Value = Range("f7").Value
    Worksheets("data").Cells(i, 8).Value = Range("f5").Value
    Worksheets("data").Cells(i, 9).Value = Range("f4").Value
    Worksheets("data").Hyperlinks.Add Worksheets("data").Cells(i, 10), Address:= _
        Range("c8").Value, TextToDisplay:=Range("c8").Value
 Else
    If Range("f4") = "Export" Then
    If Not Worksheets("data2").Columns("G:G").Find(Range("c7"), LookIn:=xlValues) Is Nothing Then
    MsgBox "same number can't save"
    Else
    i = WorksheetFunction.CountA(Worksheets("data2").Columns("D:D")) + 1
    Worksheets("data2").Cells(i, 2).Value = Range("c4").Value
    Worksheets("data2").Cells(i, 3).Value = Range("c5").Value
    Worksheets("data2").Cells(i, 4).Value = Range("c6").Value
    Worksheets("data2").Cells(i, 5).Value = Range("c7").Value
    Worksheets("data2").Cells(i, 6).Value = Range("d7").Value
    Worksheets("data2").Cells(i, 7).Value = Range("f7").Value
    Worksheets("data2").Cells(i, 8).Value = Range("f5").Value
    Worksheets("data2").Cells(i, 9).Value = Range("f4").Value
    Worksheets("data2").Hyperlinks.Add Worksheets("data2").Cells(i, 10), Address:= _
        Range("c8").Value, TextToDisplay:=Range("c8").Value
    End If
    End If
End If
End Sub