Question

我是vba newbee。请帮助解决这个问题。

到目前为止，这是我的代码

Sub Copy_and_Paste()
'
' Copy_and_Paste Macro
' Copy and Paste for test
'
'
    Windows("testv03.xlsm").Activate   
'  ActiveSheet.Paste

Dim lastRow As String

lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & lastRow).Select
Selection.PasteSpecial

Range("G16").Select
Selection.ClearComments
End Sub

请不要将上述代码只能从剪贴板复制并粘贴到最后一行

执行的任务 1.将6列复制到剪贴板（select和crtl + c） 2.然后我想将5列和所有行粘贴到最后一行活动表。 3.然后我想在已经的第6列旁边做另一个粘贴粘贴数据。即使全部复制，此粘贴任务也必须执行两次记录排队

e.g。复制到剪贴板

NO_PPC  PC_92020    601000  GC.ADM.100  NO_PCO  100.41 
NO_PPC  PC_92040    601000  RA.ADM.100  NO_PCO  100.13 
NO_PPC  PC_94010    601000  FS.ADM.100  NO_PCO  100.19

then paste
NO_PPC  PC_92020    601000  GC.ADM.100  NO_PCO
NO_PPC  PC_92040    601000  RA.ADM.100  NO_PCO  
NO_PPC  PC_94010    601000  FS.ADM.100  NO_PCO

then paste 
100.41
100.13
100.19

文件产品应如下所示粘贴到最后一行。

NO_PPC  PC_92020    601000  GC.ADM.100  NO_PCO  100.41
NO_PPC  PC_92040    601000  RA.ADM.100  NO_PCO  100.13
NO_PPC  PC_94010    601000  FS.ADM.100  NO_PCO  100.19

请帮忙。问候 Avinesh

Answer 1

我肯定会删除您使用（Ctrl + C）复制的需要，我会通过VBA来实现，如下所示，这将从A：F复制列并粘贴到您的目的地，然后它将复制列G并粘贴到目标列G（两个单独的复制/粘贴）：

Sub Copy_and_Paste()
Dim isOpen As Boolean
Dim FilePath As String
Dim lastRow As Long
Dim wsDestination As Worksheet
Dim wbDestination As Workbook
Dim wsCopyFrom As Worksheet

Set wsCopyFrom = ThisWorkbook.Worksheets("Sheet1")
'above set the worksheet you are copying from
lastRow = wsCopyFrom.Cells(wsCopyFrom.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
wsCopyFrom.Range("A1:F" & lastRow).Copy
'copy Columns A to F

FilePath = "testv03.xlsm"
'replace the name of the file with its full path, such as "C:/Users/Me/Documents/testv03.xlsm"
isOpen = IsWorkBookOpen(FilePath)

If Not isOpen Then 'check if workbook is open, if not then open it
    Set wbDestination = Workbooks.Open(FilePath)
End If

Set wsDestination = wbDestination.Sheets("Sheet1")
'above set the sheet you are copying into, amend as required

wsDestination.Range("A1").PasteSpecial
'Paste Columns A to F

wsCopyFrom.Range("G1:G" & lastRow).Copy
'copy Column G
wsDestination.Range("G1").PasteSpecial
'Paste Column G
End Sub

Function IsWorkBookOpen(Name As String) As Boolean
'function to check whether workbook is open
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function

拆分剪贴板列并粘贴

1 个答案: