时间戳

首页 > 解决方案 > 如何根据两个条件将工作簿中的工作表移动到另外两个打开的（新创建的）工作簿参考下面的代码？

excel - 如何根据两个条件将工作簿中的工作表移动到另外两个打开的（新创建的）工作簿参考下面的代码？

问题描述

Sub transfersheets()
Dim originalwb As String, ws As Worksheet, wb1name As String, wb2name As String

originalwb = ThisWorkbook.Name

wb1name = Workbooks(originalwb).Worksheets("source").Range("B2").Value & " " & "MD" & " " & "&" & " " & "Prime" & " " & "Rdg. Sht." & " " & "&" & " " & "Direct." & " " & UCase(Format(Date, "mmmm yyyy")) & ".xlsx"
wb2name = Workbooks(originalwb).Worksheets("source").Range("B2").Value & " " & "Non" & " " & "MD" & " " & "Rdg. Sht." & " " & "&" & " " & "Direct." & " " & UCase(Format(Date, "mmmm yyyy ")) & ".xlsx"

'Workbooks(originalwb).Activate
Application.ScreenUpdating = False
For Each Worksheet In Workbooks(originalwb).Worksheets

'If Len(ws.Name) > 6 Then

    If Len(Worksheet.Name) > 6 And Worksheet.Name = "NMD*" Then
     Workbooks(originalwb).ws.Move Before:=Workbooks(wb2name).Worksheets(Sheets.Count)


     ElseIf Len(Worksheet.Name) > 6 And Worksheet.Name = "PRIME*" Then
     Workbooks(originalwb).ws.Move Before:=Workbooks(wb1name).Worksheets(Sheets.Count)

     ElseIf Len(Worksheet.Name) > 6 And Worksheet.Name = "MD*" Then
     Workbooks(originalwb).ws.Move Before:=Workbooks(wb1name).Worksheets(Sheets.Count)
    End If
'End If
Next
    Workbooks(wb1name).Save
    Workbooks(wb1name).Close


    Workbooks(wb2name).Save
    Workbooks(wb2name).Close

    Workbooks(originalwb).Worksheets("source").Range("AA:AG").ClearContents

    MsgBox "The Reading Sheets & Direct Customers' Lists has  Been Successfully  Prepared."

    Application.ScreenUpdating = True
End Sub

标签： excelvba

解决方案

Dim wbTarget

For Each ws In Workbooks(originalwb).Worksheets

    If Len(ws.Name) > 6 Then

        If ws.Name Like "NMD*" Then
            Set wbTarget = Workbooks(wb2name)
        ElseIf ws.Name Like "PRIME*" Or ws.Name Like "MD*" Then
            Set wbTarget = Workbooks(wb1name)
        End If
        If Not wbTarget Is Nothing Then
            ws.Move Before:=wbTarget.Worksheets(wbTarget.Sheets.Count)
            Set wbTarget = Nothing
        End If       
    End If
Next

推荐阅读