时间戳

首页 > 解决方案 > VBA复制粘贴代码不粘贴任何东西

excel - VBA复制粘贴代码不粘贴任何东西

问题描述

有人可以让我知道为什么我的代码没有将源数据中的任何内容粘贴到目标文件中吗？此代码的目标是选择满足特定条件的行，将其复制粘贴到另一个工作簿中，代码如下所示：


 

Sub Copy_Source_LRE() 

Dim LastRow As Integer, i As Integer, erow As Integer

Workbooks.Open _

"C:\Users\sjiang\OneDrive - Canada Pension Plan Investment Board\Desktop\IOA Exposure\AAPAF_strategy_loadings_2019-04-01_2020-04-01 (2).csv"

Worksheets("AAPAF_strategy_loadings_2019-04").Activate

Set sht = ActiveSheet

'Workbooks("AAPAF_strategy_loadings_2019-04-01_2020-04-01 (2).csv").Sheets("AAPAF_strategy_loadings_2019-04").Activate

LastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row

For i = 2 To LastRow

For Each d In Array("4/1/2019", "5/1/2019", "6/3/2019", "7/1/2019", "8/1/2019", "9/2/2019", _

"10/1/2019", "11/1/2019", "12/2/2019", "1/2/2020", "2/3/2020", "3/2/2020") 

    If Cells(i, 2) = d And Cells(i, 3) = "Real Estate" And Cells(i, 4) = "Listed Real Estate" And Cells(i, 5) = "AAPAF_SA" Then

    Range(Cells(i, 2), Cells(i, 12)).Select

    Selection.Copy
    Workbooks.Open _
    "C:\Users\sjiang\OneDrive - Canada Pension Plan Investment Board\Desktop\IOA Exposure\pull data.xlsm"
    Worksheets("Sheet1").Select

    erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    ActiveSheet.Cells(erow, 1).Select
    ActiveSheet.Paste
    ActiveWorkbook.Save
'ActiveWorkbook.Close
    End If
Next d

Next i

Application.CutCopyMode = False

End Sub

标签： excelvbaloopsfor-loop

解决方案

这是一种非常简单且基本的方法，我一直使用它来将数据复制到新工作簿中。在此示例中，我将一个名为“MasterData”的命名范围复制到一个新的空白工作簿中。然后我用密码保存那本新书并重新激活当前工作簿。

Dim newfilename As String
newfilename = "/Users/" & userName & "/Desktop/savedWorkbook.xlsx"
Dim NewBook As Workbook
Set NewBook = Workbooks.Add
ThisWorkbook.Activate
Sheets("Datasheet").Select
Range("MasterData").Copy
NewBook.Activate
NewBook.Sheets(1).Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
NewBook.SaveAs Filename:=newfilename, Password:="examplepassword", AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
NewBook.Close (True)
ThisWorkbook.Activate

推荐阅读