如何将包含某些文本的单元格复制到另一个工作表[关闭]

1 回答

• 1

  根据评论我修改了代码只复制指定的范围，两个表格都应该存在，代码不会为你创建第二个工作表：

  Sub Test()
  Dim Cell As Range
  
  With Sheets("Sheet1") 'Sheet with data to check for value
      ' loop column H untill last cell with value (not entire column)
      For Each Cell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
          If Cell.Value = "1234" Then
              NextFreeRow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row + 1
               'get the next empty row to paste data to
              .Range("A" & Cell.Row & ",B" & Cell.Row & ",C" & Cell.Row & ",F" & Cell.Row).Copy Destination:=Sheets("Sheet2").Range("A" & NextFreeRow)
          End If
      Next Cell
  End With
  End Sub
  

  UPDATE:

  下面的代码将在H列的每个单元格内搜索文本“1234”，如果找到则会复制您想要的范围 .

  Sub Test()
  Dim Cell As Range
  
  With Sheets("Sheet1") 'Sheet with data to check for value
      ' loop column H untill last cell with value (not entire column)
      For Each Cell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
          pos = InStr(Cell.Value, "1234")
          If pos > 0 Then
              NextFreeRow = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row + 1
               'get the next empty row to paste data to
              .Range("A" & Cell.Row & ",B" & Cell.Row & ",C" & Cell.Row & ",F" & Cell.Row & "," & Cell.Address).Copy Destination:=Sheets("Sheet2").Range("A" & NextFreeRow)
          End If
      Next Cell
  End With
  End Sub
  

  回复于 2024-04-24T20:08:27+08:00