VBA覆盖或追加到新工作簿

时间:2018-12-04 09:48:01

标签: excel vba

我有VBA代码正在工作但没有完成(我可以将新行追加到另一个工作簿上,但是我无法弄清楚如果其他工作簿上已经存在这些单元格,那么如何覆盖这些单元格)。逻辑是如果A列中的数据,E和F已经存在于我的主工作簿上,然后覆盖其他附加项。数据范围为A1:F15。标题位于行1上,用户将仅在单元格B2:D15中名为TaskList的SheetName中输入。这是我当前的VBA,也是我无法锻炼的VBA的第三部分。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 1 Then Exit Sub  ' IF ITS A HEADER, DO NOTHING.
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
ErrHandler:
   Application.EnableEvents = True
  Application.ScreenUpdating = True

this captures if someone enters anything in any of the 3 fields and puts their username and entered date in
 If Target.Column = 2 And Target.Row > 1 Or Target.Column = 3 And Target.Row > 1 Or Target.Column = 4 And Target.Row > 1 Then
        Cells(Target.Row, 5).Value = Application.UserName
        Cells(Target.Row, 6).Value = DateTime.Now
  End If
End Sub

此工作簿VBA

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call CopyTasks
End Sub


 Private Sub Workbook_Open()
Dim rng As Range
Set rng = Range("B2:F15")
rng.ClearContents
End Sub

这会将数据发送到另一个工作簿

    Sub CopyTasks()
Dim LastRow As Long, i As Long, erow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 5).Value = Application.UserName Then
Dim rng As Range
Set rng = Range(Cells(i, 1), Cells(i, 6))
rng.Copy
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open("C:\Users\myname\Documents\Master TaskList Data.xlsm")
Set ws = Worksheets("Data")
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
 ActiveSheet.Paste
 ActiveWorkbook.Save
 ActiveWorkbook.Close
 Application.CutCopyMode = False
 End If
Next i
End Sub

0 个答案:

没有答案