從一個工作簿中復制特定數據並將其粘貼到另一工作簿中（從第二行粘貼）

Question

我需要從一個工作簿中復制棕褐色的顏色單元格，然后粘貼到另一個工作簿中。 並且只需要采用該Excel中的特定單元格值。 我實現了這一點，但是只能將其粘貼到同一工作簿中的另一張表中。 您能幫我將數據粘貼到特定工作表上的另一個工作簿上嗎，並且值也應該粘貼到第二行（即從第二行開始）中，因為第一行中有標題。

源表標題：

項目| 相| 現狀 st Dt | 結束Dt | 預| 資源| 備注| 評論

目標表標題：

項目| 相| 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

您真的很接近讓它完成您想要的事情。 致命的缺陷是您在嘗試激活目標文件時第二次打開目標文件，從而刪除了為其分配的y變量。 不需要使目標文件處於活動狀態，但是如果出於某種原因您真的希望它變為活動狀態，那么我會加入一行以使其生效。

除此之外，我進行了一些小更改，並就為什么進行了評論。

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