Excel 将所有值从一张图纸复制并粘贴到另一张图纸

我有一个宏，可以创建一个充满数据的工作表。我最近添加了新的工作表，这样每个工作表都可以有唯一的值。例如，如果一行包含“变极”，则整个行将被复制并粘贴到“变极”工作表中。有4张不同的纸。我的问题是，由于某些值是由vba中的公式确定的，因此某些值不会移动到新的工作表中

Sub copy_paste_based_on_cell_interior_rgb()
Dim LastRow As Long

Dim i As Long, j As Long

'Find the last used row in a Column: column A in this example
 With Worksheets("Make-Ready")
  LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
 End With

'first row number where you need to paste values in Sheet1'
With Worksheets("Pole Change Out")
  j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

For i = 1 To LastRow
   With Worksheets("Make-Ready")
       If .Cells(i, 27).Value = "Pole Change-Out" Then
           .Rows(i).Copy Destination:=Worksheets("Pole Change Out").Range("A" & j)
           j = j + 1
       ElseIf .Cells(i, 27).Value = "New Midspan Pole" Then
           .Rows(i).Copy Destination:=Worksheets("Midspan Poles").Range("A" & j)
           j = j + 1
       ElseIf .Cells(i, 104).Value = "Yes" Then
           .Rows(i).Copy Destination:=Worksheets("Anchor Replacement").Range("A" & j)
           j = j + 1
       End If
   End With
   Next i

   End Sub

---

正如@scottCraner和其他人指出的那样。您正试图在另两张工作表上使用一张工作表中的第一个空单元格变量。对代码的更新将自动更新每张工作表的第一个空白单元格

Sub copy_paste_based_on_cell_interior_rgb()
Dim LastRow As Long

Dim i As Long ', j As Long

'Find the last used row in a Column: column A in this example
 With Worksheets("Make-Ready")
  LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
 End With

'first row number where you need to paste values in Sheet1'
'With Worksheets("Pole Change Out")
'  j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
'End With

For i = 1 To LastRow
   With Worksheets("Make-Ready")
       If .Cells(i, 27).Value = "Pole Change-Out" Then
           .Rows(i).Copy Destination:=Worksheets("Pole Change Out").Cells(Rows.Count, 1).End(xlUp).Offset(1)

           'j = j + 1
       ElseIf .Cells(i, 27).Value = "New Midspan Pole" Then
           .Rows(i).Copy Destination:=Worksheets("Midspan Poles").Cells(Rows.Count, 1).End(xlUp).Offset(1)

           'j = j + 1
       ElseIf .Cells(i, 104).Value = "Yes" Then
           .Rows(i).Copy Destination:=Worksheets("Anchor Replacement").Cells(Rows.Count, 1).End(xlUp).Offset(1)

           'j = j + 1
       End If
   End With
   Next i

   End Sub

---

因为你在一张纸的基础上设置

j

，并在其中添加一张，无论粘贴到哪张纸，所有的纸上都会出现空行。我在问题@scottcraner中附上了我目前的结果，虽然这些都是漂亮的图片，但如果没有更多的上下文，它们对我们来说没有任何意义。这些图片有什么问题？在您的代码中，j是“杆更换”空白行的行号。我认为代码需要其他表的不同变量，“中跨杆”和“锚更换”。在“准备就绪”表的屏幕截图中，没有“杆更换”、“新中跨杆”或“是”值，因此，你期望从这个循环中得到什么？如果找不到该值，则无法复制该值。