我编写了以下脚本,根据一组条件将一系列数据从一个工作表复制到另一个工作簿。我现在需要添加一个额外的部分来过滤这个可接受的数据到以G列中的值命名的不同工作表,如果该值不存在则创建以该值命名的工作表。例如,如果列G值= JULA,则将其复制到工作表JULA,但如果这不存在则创建并复制。
Private Sub cmdArchive_click()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim LastRow As Integer, i As Integer, erow As Integer
iForm = ("\\Insurance\It\FileData\Computers\Release Note\Collated Release Records\Master.xlsx")
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
If Cells(i, 1) <> "" And Cells(i, 9) = "" And Cells(i, 9) = "" Then
Range(Cells(i, 1), Cells(i, 4)).Select
Selection.Copy
workbooks.Open Filename:=iForm
Worksheets("Scheduled Forms").Select
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
MsgBox ("iForms have been archived, please clear the Team Release notes ready for the next implimentation window"), vbInformation + vbOKOnly, "Complete!"
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
提前谢谢。