从一个工作簿复制特定数据并将其粘贴到另一个工作簿（从第二行粘贴）

我需要从一个工作簿复制棕褐色的单元格并粘贴到另一个工作簿。 并且只需要在该excel中仅使用特定的单元格值。 我实现了这一点，但只能粘贴到同一工作簿中的另一张工作表。 你可以帮我把数据粘贴到另一个工作簿上，这个值也应该粘贴在第二行（即从第二行开始），因为第一行有标题。

源表标题：

项目| 阶段| 状态| st Dt | 结束Dt | Pre | 资源| 备注| 注释

目录表标题：

项目| 阶段| st Dt | 结束Dt | 资源|

现有代码：

Option Explicit Sub CopyRowsGroup() Dim wks As Worksheet Dim wNew As Worksheet 'Dim y As Workbook Dim lRow As Long Dim lNewRow As Long Dim x As Long Dim ptr As Long Set wks = ActiveSheet lRow = wks.Cells.SpecialCells(xlCellTypeLastCell).Row Set wNew = Worksheets.Add 'Set y = Workbooks.Open("C:\Users\1519728\Desktop\Capacity Planning Tracker-ver1.0.xlsx") 'Workbooks.Open("C:\Users\1519728\Desktop\Capacity Planning Tracker-ver1.0.xlsx").Activate 'Set wNew = y.Sheets("Data dump") lNewRow = 1 For x = 1 To lRow If wks.Cells(x, 1).Interior.Color = RGB(221, 217, 195) Then wks.Cells(x, 1).EntireRow.Copy wNew.Cells(lNewRow, 1).PasteSpecial Paste:=xlPasteValues lNewRow = lNewRow + 1 End If Next wNew.Rows([1]).EntireRow.Delete wNew.Columns([3]).EntireColumn.Delete wNew.Columns([3]).EntireColumn.Delete wNew.Columns([5]).EntireColumn.Delete wNew.Columns([6]).EntireColumn.Delete wNew.Columns([6]).EntireColumn.Delete wNew.Columns([6]).EntireColumn.Delete For ptr = 2 To lNewRow - 2 If Cells(ptr, "A") = vbNullString Then Cells(ptr, "A") = Cells(ptr, "A").Offset(-1, 0) End If Next End Sub 

Answer 1

你真的接近于做你想做的事情。 这个致命的缺陷是在你尝试激活它时第二次打开目标文件的地方，它删除了你已经分配了上面的行的yvariables。 没有必要使你的目标文件处于活动状态，但是如果出于任何原因，你真的希望它变成活动的，我将包含一个让它工作的线。

除此之外，我做了一些小小的修改，并留下了为什么要这样做的意见。

 Sub CopyRowsGroup() Dim wks As Worksheet Dim wNew As Worksheet Dim y As Workbook Dim lRow As Long Dim lNewRow As Long Dim x As Long Dim ptr As Long Set wks = ActiveSheet lRow = wks.Cells.SpecialCells(xlCellTypeLastCell).Row 'Set wNew = Worksheets.Add 'commented out since we're using the destination file as the paste location Set y = Workbooks.Open("C:\Users\1519728\Desktop\Capacity Planning Tracker-ver1.0.xlsx") 'The line below is what was causing your problems. You opened the workbook again and erased your y variable 'Workbooks.Open("C:\Users\1519728\Desktop\Capacity Planning Tracker-ver1.0.xlsx").Activate 'you don't need to activate a workbook after opening it 'If you really want to make the workbook active, simply use the line below 'y.Activate Set wNew = y.Sheets("Data dump") 'Copy the rest of your data over lNewRow = 2 'Changed to 2 to accomodate the header in row 1 For x = 1 To lRow If wks.Cells(x, 1).Interior.Color = RGB(221, 217, 195) Then wks.Cells(x, 1).EntireRow.Copy wNew.Cells(lNewRow, 1).PasteSpecial Paste:=xlPasteValues lNewRow = lNewRow + 1 End If Next 'wNew.Rows([1]).EntireRow.Delete 'This was deleting the header column which I am assuming was already in the sheet based on your request for the data to begin being copied to row 2 wNew.Columns([3]).EntireColumn.Delete 'wNew.Columns([3]).EntireColumn.Delete 'this was deleting the end dt column, which you listed as one of the columns you wanted to keep wNew.Columns([5]).EntireColumn.Delete wNew.Columns([6]).EntireColumn.Delete wNew.Columns([6]).EntireColumn.Delete 'wNew.Columns([6]).EntireColumn.Delete 'not deleting anything so we don't need it For ptr = 2 To lNewRow - 2 If Cells(ptr, "A") = vbNullString Then Cells(ptr, "A") = Cells(ptr, "A").Offset(-1, 0) End If Next End Sub