将数据复制到另一个工作簿并根据条件筛选到不同的工作表

时间:2016-06-29 18:38:46

标签: excel vba excel-vba

我编写了以下脚本,根据一组条件将一系列数据从一个工作表复制到另一个工作簿。我现在需要添加一个额外的部分来过滤这个可接受的数据到以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

提前谢谢。

0 个答案:

没有答案