Excel VBA将粘贴复制到Sharepoint

需要打开一组锁定的工作簿，复制和过去的数据集，并重新锁定和关闭工作簿。一切正常，但数据不会粘贴到新的工作手册中，不知道发生了什么

我知道它正在复制数据，但不确定为什么它不会粘贴。我在本地文件和SharePoint上试用过，但都不起作用 代码如下：

Sub exportdata()

'Basic Parameters for entire code

'Timer to measure total macro run time

    Dim StartTime As Double
    Dim MinutesElapsed As String
    StartTime = Timer
    
    Dim Data_Export As Workbook
    Set Data_Export = ThisWorkbook
    
    Dim Data_Location As Worksheet
    Set Data_Location = Data_Export.Sheets("Data_Location")
    
    Dim PS_ROllOUT As Worksheet
    Set PS_ROllOUT = Data_Export.Sheets("Export_Data")
    
    
    Application.ScreenUpdating = False

'Step 1: Code to open up store review workbooks (set up as a loop)

    Dim i As Long
    For i = 2 To Application.CountA(Data_Location.Range("D:D"))
    
    Application.StatusBar = "Current iteration: " & i - 1 & " of " & Application.CountA(Data_Location.Range("D2:D100")) & " - " & Data_Location.Range("A" & i)
    
    
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=Data_Location.Range("D" & i).Value, ReadOnly:=False, notify:=True
    Application.DisplayAlerts = True
                
         '''Code below opens workbook and requires user to manually accept read only version
         'Workbooks.Open Filename:=Data_Location.Range("D" & i)

    On Error Resume Next

'Step 2: Unlocking workbook and bud table

    Dim Factory_BUD As Workbook
    Set Factory_BUD = ActiveWorkbook
    
    Factory_BUD.Unprotect "bud"
    Worksheets("Export_Data").Visible = True
    Worksheets("Export_Data").Unprotect "bud"
    
    Dim Export_Data As Worksheet
    Set Export_Data = ThisWorkbook.Sheets("Export_Data")


'step 3 : Copy Budtable Data

    PS_ROllOUT.Activate
    Range("A1:AH1000").Copy
    
    Export_Data.Activate
    Worksheets("Export_Data").Select
    Range("A1").Select.PasteSpecial xlPasteValues

'step4: Close and lock workbooks

    Factory_BUD.Activate
    Worksheets("Export_Data").Protect "bud"
    Worksheets("Export_Data").Visible = False
    Factory_BUD.Protect "bud"
    Factory_BUD.Close SaveChanges = True
    
    Next i
    
    Application.ScreenUpdating = True
    Application.StatusBar = False
    PS_ROllOUT.Activate
    
    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
    
    
    MsgBox ("Rollup Budget Updated" & vbNewLine & _
            "Total run time: " & MinutesElapsed & " minutes"), vbInformation

End Sub

这是我的方法

一些建议：

• 在模块顶部使用

  选项explicit

  ，这样就不会出现未定义变量的意外行为
• 始终缩进您的代码（请参阅[www.ruberduckvba.com][1]，这是一个免费的工具，可以帮助您进行缩进）
• 尝试将定义变量的逻辑与重用变量的逻辑分开
• 将变量命名为有意义且易于理解的名称（避免i或x）
• 首先用简单的英语编写代码步骤，然后用VBA进行开发（你已经有了一些东西）
• 检查代码的注释，并根据需要进行调整

注意：我强烈建议您验证一些内容，例如工作簿是否已打开，工作表是否存在

代码

---

让我知道它是否有效

在错误恢复上注释

，下一行

用

F8

键进入代码并报告。同时在模块顶部添加

选项Explicit

。您的代码无法编译

Public Sub ExportDataToSP()

    ' Basic error handling
    On Error GoTo CleanFail
    
    ' Turn off stuff
    Application.ScreenUpdating = False
    
    ' Timer: to measure total macro run time
    Dim startTime As Double
    Dim minutesElapsed As String
    startTime = Timer
    
    ' Set data export references
    Dim dataExportWorkbook As Workbook
    Dim dataExportSheet As Worksheet
    Set dataExportWorkbook = ThisWorkbook
    Set dataExportSheet = dataExportWorkbook.Worksheets("Export_Data")
    
    ' Set data location references
    Dim dataLocationSheet As Worksheet
    Set dataLocationSheet = dataExportWorkbook.Worksheets("Data_Location")
    
    
    ' Step 1: Code to open up store review workbooks (set up as a loop)
    Dim fileCounter As Long
    Dim totalFiles As Long
    Dim fileInfo As String
    Dim filePath As String
    totalFiles = Application.CountA(dataLocationSheet.Range("D:D"))
    For fileCounter = 2 To totalFiles
        
        ' Gather file data
        fileInfo = dataLocationSheet.Range("A" & fileCounter)
        filePath = dataLocationSheet.Range("D" & fileCounter)
        
        ' Set status bar message
        Application.StatusBar = "Current iteration: " & fileCounter - 1 & " of " & totalFiles & " - " & fileInfo
        
        ' Open target workbook (SharePoint)
        Dim targetWorkbook As Workbook
        Application.DisplayAlerts = False
        Set targetWorkbook = Workbooks.Open(Filename:=filePath, ReadOnly:=False, Notify:=True)
        Application.DisplayAlerts = True
        
        ' Set target sheet in SharePoint workbook
        Dim targetSheet As Worksheet
        Set targetSheet = targetWorkbook.Worksheets("Export_Data")
        
        ' Step 2: Unlocking workbook and bud table
        targetWorkbook.Unprotect "bud"
        targetSheet.Visible = True
        targetSheet.Unprotect "bud"
        
        ' Set data export range
        Dim dataExportRange As Range
        Set dataExportRange = dataExportSheet.Range("A1:AH1000")
        
        ' Step 3: Copy Bud table Data (Values)
        targetSheet.Range("A1").Resize(dataExportRange.Rows.Count, dataExportRange.Columns.Count).Cells.Value = dataExportRange.Cells.Value
        
        ' Step 4: Close and lock workbooks
        targetSheet.Protect "bud"
        targetSheet.Visible = False
        targetWorkbook.Protect "bud"
        targetWorkbook.Close SaveChanges:=True
        
    Next fileCounter
    
    ' Timer: Display elapsed time
    minutesElapsed = Format((Timer - startTime) / 86400, "hh:mm:ss")
    MsgBox ("Rollup Budget Updated" & vbNewLine & _
            "Total run time: " & minutesElapsed & " minutes"), vbInformation
            
CleanExit:
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Exit Sub
 
CleanFail:
    Debug.Print "Something went wrong: " & Err.Description
    Resume CleanExit
            
End Sub