如何在 Excel 中根据单元格值将整行移动到另一张工作表?

ms excelmicrosoft technologiesadvanced excel function更新于 2025/1/24 11:56:17

如果您经常处理大型数据集或需要高效地组织数据，本课将向您展示如何根据特定条件自动移动行。Excel 是组织和分析数据的有效工具，利用其特性和功能，我们可以自动化耗时的流程，从而节省精力和时间。例如，在筛选和分类数据时，通常需要根据单元格值将整行移动到另一张工作表。

根据单元格值将整行移动到另一张工作表

在这里，我们将首先创建一个 VBA 模块，然后运行它来完成任务。让我们看一个简单的过程，了解如何在 Excel 中根据单元格值将整行移动到另一个工作表。

步骤 1

假设有一个 Excel 工作表，其中的数据与下图类似。

首先，右键单击工作表名称，然后选择"查看代码"以打开 VBA 应用程序。

右键单击 >"查看代码"。

步骤 2

然后点击"插入"，选择"模块"，然后将以下代码复制到文本框中。

插入 >"模块">"复制"。

代码

Sub Cheezy()
   Dim xRg As Range
   Dim xCell As Range
   Dim I As Long
   Dim J As Long
   Dim K As Long
   I = Worksheets("Sheet1").UsedRange.Rows.Count
   J = Worksheets("Sheet2").UsedRange.Rows.Count
   If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
   End If
   Set xRg = Worksheets("Sheet1").Range("C:C" & I)
   On Error Resume Next
   Application.ScreenUpdating = False
   For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Done" Then
         xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
         xRg(K).EntireRow.Delete
         If CStr(xRg(K).Value) = "Done" Then
             K = K - 1
         End If
         J = J + 1
      End If
   Next
   Application.ScreenUpdating = True
End Sub

代码中，Sheet1 是包含要移动行的工作表。Sheet2 是要定位该行的目标工作表。"C:C"是包含特定值的列，"Done"是移动行时所依据的特定值。请根据您的需求进行更改。

步骤 3

然后点击 F5 完成任务。

以下是如何在 Excel 中根据单元格值将整行移动到另一个工作表的方法。

注意

如果要复制基于数据的单元格值，请使用以下代码。

代码

Sub MoveRowBasedOnCellValue()
   Dim xRg As Range
   Dim xCell As Range
   Dim I As Long
   Dim J As Long
   Dim K As Long
   I = Worksheets("Sheet1").UsedRange.Rows.Count
   J = Worksheets("Sheet2").UsedRange.Rows.Count
   If J = 1 Then
   If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
   End If
   Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
   On Error Resume Next
   Application.ScreenUpdating = False
   For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Done" Then
         xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
         J = J + 1
      End If
   Next
   Application.ScreenUpdating = True
End Sub