Question

我正在用Excel制作工作簿，该工作簿将数据从一张纸发送到其他工作簿。我正在为此使用复制和粘贴方法。工作簿保存在Sharepoint（Onedrive）中并被共享。

我们有两种工作簿，第一种是项目计划者，第二种是所有项目的集合，概述了该项目目前所处的阶段，并提供了一些评论。这是两行数据。

该代码基本上找到了要复制（范围）的正确的星期和行，然后打开了收集工作簿，并搜索了将数据粘贴到其中的行和列。这在收集工作簿中。之后，将第一个范围复制并粘贴到第二个范围

因此，我们在测试该系统时发现了一些问题。如果集合工作簿或项目工作簿中有多个人。它说有一些修正，所以必须重新打开文件。

我的最佳猜测是，有些代码行在Office 365的这种共享模式下无法正常工作。因为当我们通常使用共享工作表并简单地键入数据时，数据最终会出现一些延迟

我不确定这段代码是否足够清晰可读。

Sub SyncToBureauplanner()

'Finds the projectplanner

 Dim Thisproject As String
    Thisproject = Range("A10").Value

Dim Projectplanner As String
    Projectplanner = Thisproject & ".xlsm"

'remove protection from the projectplanner

'locate the bureauplanner

Dim ThisUser As String
    ThisUser = Environ("username")

Dim Disk As String
    Disk = "C:\Users\"

Dim Bureauplannerspath As String
    Bureauplannerspath = "\bureau\planning 
- Documenten\Bureauplanning\"

Dim File As String
    File = "Bureauplanning.xlsm"

Dim BureauplannerPath As String
    BureauplannerPath = Disk & ThisUser & Bureauplannerspath & File

'opens the bureauplanner

Workbooks.Open (BureauplannerPath)

'Remove protection from the Bureauplanner
Workbooks("Bureauplanning.xlsm").Sheets("Planning").Unprotect

'Search for the column of this week
Workbooks(Projectplanner).Activate
Workbooks(Projectplanner).Sheets("Planning").Unprotect

Dim CurrentWeek As String
    CurrentWeek = 
Workbooks(Projectplanner).Sheets("Planning").Range("C7").Value

Dim Weekcolumn As Range
    With Workbooks(Projectplanner).Sheets("Planning").Range("15:15")
    Set Weekcolumn = .Find(What:=CurrentWeek, LookIn:=xlValues, 
LookAt:=xlWhole, MatchCase:=False, Searchformat:=False)

    End With

'Makes the range wich will be copied


Dim GeneralData As Range
Set GeneralData = 
Workbooks(Projectplanner).Sheets("Planning").Range(Cells(16, 
Weekcolumn.Column), Cells(17, Weekcolumn.Offset(0, 106).Column))

'Search for the column and row where the Generaldata will be pasted
Dim ThisWeek As Range

    Dim CurrentBureauWeek As String
        CurrentBureauWeek = 
Workbooks(Projectplanner).Sheets("Planning").Range("C7").Value

With Workbooks("Bureauplanning.xlsm").Sheets("Planning").Range("M10:DM10")
Set ThisWeek = .Find(What:=CurrentBureauWeek, LookIn:=xlValues, 
LookAt:=xlWhole, MatchCase:=False, Searchformat:=False)
If Not ThisWeek Is Nothing Then

End If
End With

Dim Thisprojecrow As Range

With Workbooks("Bureauplanning.xlsm").Sheets("Planning").Range("B:B")
Set Thisprojectrow = .Find(What:=Thisproject, LookIn:=xlValues, 
LookAt:=xlWhole, MatchCase:=False, Searchformat:=False)
If Not Thisprojectrow Is Nothing Then

End If
End With

Dim PasteStartcell As Range
Set PasteStartcell = 
Workbooks("Bureauplanning.xlsm").Sheets("Planning").Cells
(Thisprojectrow.Offset(-1, 0).Row, ThisWeek.Column)

Dim PasteEndcell As Range
Set PasteEndcell = 
Workbooks("Bureauplanning.xlsm").Sheets("Planning").Cells 
(Thisprojectrow.Row, ThisWeek.Offset(0, 106).Column)

Dim Pasterange As Range
Set Pasterange = Range(PasteStartcell, PasteEndcell)

GeneralData.Copy
Pasterange.PasteSpecial (xlPasteValues)

Workbooks("Bureauplanning.xlsm").Sheets("Planning").Protect , 
UserInterfaceonly:=True
Workbooks("Bureauplanning.xlsm").Close

Workbooks(Projectplanner).Sheets("Planning").Protect , 
UserInterfaceonly:=True

End Sub

我希望有人能告诉我如何在不重新打开文件的情况下将数据复制并粘贴到其他工作簿中，以便在其他人位于文件中时可以对其进行更新

共享文件共享点中的宏

0 个答案: