Search a specific word and copy line to another Sheet

后端 未结 1 1863
别跟我提以往
别跟我提以往 2021-01-26 00:26

I have a spreadsheet that consists of columns from A-P and lines 1 to 2016 (and still growing). I am looking for an easy way to search the spreadsheet for a specific word, for

相关标签:
1条回答
  • 2021-01-26 01:00
    'all variables must be declared    
    Option Explicit
    Sub CopyData()
    
    'this variable holds a search phrase, declared as variant as it might be text or number
    Dim vSearch As Variant
    'these three variables are declared as long, technically the loop might exceed 32k (integer) therefore it is safer to use long
    Dim i As Long
    Dim k As Long
    Dim lRowToCopy As Long
    
    'the macro prompts a user to enter the search phrase
    vSearch = InputBox("Search")
    'varialbe i initially declared as 1 - macro starts calculations from the 1st row
    i = 1
    'macro will loop until it finds a row with no records
    'I called a standard XLS function COUNTA to count the number of non-blank cells
    'if the macro finds a row with no records it quits the loop
    Do Until WorksheetFunction.CountA(Sheets("Main").Rows(i)) = 0
    
     'here I let the macro to continue its run despite a possible errors (explanation below)
      On Error Resume Next
      lRowToCopy = 0
     'if Find method finds no value VBA returns an error, this is why I allowed macro to run despite that. In case of error variable lRowToCopy keeps 0 value
     'if Find method finds a searched value it assigns the row number to var lRowToCopy
      lRowToCopy = Sheets("Main").Rows(i).Find(What:=vSearch, LookIn:=xlValues,     LookAt:=xlPart, SearchOrder:=xlByRows).Row
     'here we allow macro to disiplay error messages
      On Error GoTo 0
    
     'if var lRowToCopy does not equal to 0 that means a row with a searched value has been found
      If lRowToCopy > 0 Then
    
        'this loop looks for the first blank row in 2nd sheet, I also used COUNTA to find absolutely empty row
        For k = 1 To Sheets("ToCopy").Rows.Count
    
          'when the row is found, the macro performs copy-paste operation
          If WorksheetFunction.CountA(Sheets("ToCopy").Rows(k)) = 0 Then
    
              Sheets("Main").Rows(i).Copy
              Sheets("ToCopy").Select
              Rows(k).Select
              ActiveSheet.Paste
              'do not forget to exit for loop as it will fill all empty rows in 2nd sheet
              Exit For
    
          End If
        Next k
    
      End If
    
    i = i + 1
    Loop
    
    End Sub
    
    0 讨论(0)
提交回复
热议问题