将所有值从一张表复制并粘贴到另一张表答案

【问题标题】：Copy and pasting all values from one sheet to another将所有值从一张表复制并粘贴到另一张表
【发布时间】：2020-01-13 18:27:36
【问题描述】：

我有一个宏，可以创建一个充满数据的工作表。我最近添加了新工作表，以便可以将唯一值放入每个工作表中。例如，如果一行包含“Pole Change Out”，那么整行将被复制并粘贴到“Pole Change Out”表中。有 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

【问题讨论】：

因为你在一张纸上设置j，不管贴到哪张纸上都加一张，所以所有的纸上都会有空行。
我在@ScottCraner 问题中附上了我目前的结果
虽然这些都是漂亮的图片，但如果没有更多的上下文，它们对我们没有任何意义。这些图片有什么问题？
在您的代码中，j 是“Pole Change Out”上空白行的行号。我认为代码需要其他工作表的不同变量，“中跨极”和“锚替换”。
在“Make-Ready”表的 ScreenCaptures 中，没有“Pole Change-Out”、“New Midspan Poles”或“Yes”值，因此，您应该期待什么从这个循环？如果找不到值，则无法复制。

标签： excel vba

【解决方案1】：

正如@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

【讨论】：