Question

美好的一天：

我尝试使用ActiveX命令按钮将Excel工作表复制到另一个文件中。这是背景：

我有excel日志表，每天都在填写。日志具有每日运行的设定标准（A，B，C等）。虽然我们仍然希望将日志保存在每日文件中，但我希望命令按钮能够作为主文件导出到另一个工作簿（例如＆＃34; A_Masterfile＆＃34;，＆＃34; B_Masterfile＆＃34;，等）。

我尝试过研究，但所有这些要求都来自不同的网站/网页。但由于他们使用的方法是如此不同，我很难让所有的Syntax都适合，以便一个代码可以做任何事情。

作为一个纲要，这就是我想要它做的事情：

将活动工作表导出到另一个工作簿

a）如果存在工作簿，请将工作表复制到工作簿末尾

b）如果工作簿不存在，请创建工作簿和副本表
目标工作簿基于单元格（标准A，B等）
目标工作簿可能与源工作表/工作簿位于不同的文件夹中

根据我到目前为止的研究情况，这就是我所提出的。

当简单地复制时，这就是我所读到的，但我无法让它工作。

ActiveSheet.Copy After:=Workbooks("Destination.xlsx").Worksheets(Worksheets.Count)

对于创建新文件，这是我读到的，但即使是从原始网站，他们说问题是它复制整个工作簿，而不仅仅是一个特定的工作表。

ActiveWorkbook.SaveAs "C:\path\Destination.xlsx"

最后，我读到了连接以创建＆＃34;目的地＆＃34;文件名基于单元格值。但是，我迷失了所有的语法。我试过简单地复制粘贴，但我无法让它发挥作用。

这有点问题。非常感谢您的帮助！如果我能澄清任何事情，请告诉我。

P.S。额外注意：我在学校完成了一些QBasic和MATLAB以及一些JAVA编程，所以我把逻辑部分搞定了。但我对VBA语法很陌生，因此需要额外的信息。：）

更新：我刚学会了＃34;记录宏＆＃34;我尝试使用它

我从中得到了它并且有效：

Sheets("SourceSheet").Select
ActiveSheet.CheckBoxes.Add(639, 30, 58.8, 16.8).Select
ActiveSheet.CheckBoxes.Add(639.6, 44.4, 58.8, 16.8).Select
ActiveSheet.CheckBoxes.Add(639.6, 61.2, 58.8, 16.8).Select
ActiveSheet.OptionButtons.Add(1279.8, 37.8, 20.4, 18).Select
ActiveSheet.OptionButtons.Add(1280.4, 57, 21.6, 17.4).Select
Sheets("SourceSheet").Copy After:=Workbooks("DestinationMasterFile.xlsx").Sheets(1)
Windows("SourceWorkBook.xlsm").Activate

它可以工作，但只能将它放在第一张纸之后，而不是放在最后。我知道它来自.Sheets（1），但我不知道如何写它。感谢。

Answer 1

我做了更多的研究和试验和错误，我想出了一个有效的代码。这可能很麻烦，但它确实有效。任何进一步的改进都表示赞赏。

Private Sub CommandButton1_Click()

'Code for Locking
Sheets("W").Unprotect
Range("A1:BZ125").Locked = True
Sheets("W").Protect Password:="hello"






'Code for Copying

'Declarations
Dim Wk As Workbook
Dim FName As String
Dim FNameTwo As String
Dim FilePath As String
Dim TestStr As String
Dim wb As Workbook

'Initializing Constants
Set wb = ThisWorkbook
FName = "C:\Users\PHReyesDa\Desktop\" & Range("BO1") & ".xlsx"
FNameTwo = Range("BO1") + ".xlsx"

'If statement Setup (if exist)
FilePath = FName
    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0

'If statement

If TestStr = "" Then
        'If not existing, create new file
        MsgBox "File didn't exist yet; new file created"
        Set Wk = Workbooks.Add
        Application.DisplayAlerts = False
        Wk.SaveAs Filename:=FName
        Application.DisplayAlerts = True
        Workbooks(FNameTwo).Close SaveChanges:=True
End If

'Reopens Master File
Workbooks.Open FName

wb.Activate

'Find number of worksheets in destination workbook to worksheet could be copied to end of workbook
Dim Num As Integer
Num = Workbooks(FNameTwo).Worksheets.Count

'Copy source worksheet to (the end of) destination workbook
Sheets("W").Select
Sheets("W").Copy After:=Workbooks(FNameTwo).Worksheets(Num)

'Close and save new workbook, confirmation of successful copy
Workbooks(FNameTwo).Close SaveChanges:=True
MsgBox "Worksheet successfully exported and saved to master file"

End Sub

Excel：将工作表复制到另一个工作簿（无论是现有的还是新的）

1 个答案: