![](/img/trans.png)
[英]VBscript: Copy/Paste data from one workbook to next blank row (specific cells) of another workbook
[英]Copy specific data from one workbook and paste it into another workbook (paste from second row)
我需要从一个工作簿中复制棕褐色的颜色单元格,然后粘贴到另一个工作簿中。 并且只需要采用该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
您真的很接近让它完成您想要的事情。 致命的缺陷是您在尝试激活目标文件时第二次打开目标文件,从而删除了为其分配的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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.