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

Question

我需要從一個工作簿中複製棕褐色的單元格並粘貼到另一個工作簿中。並且只需要在該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

你是真正接近讓它做你想做的。致命的缺陷是您在嘗試激活目標文件時第二次打開目標文件的位置，該文​​件刪除了您爲其分配了上面一行的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