如何根据两个条件将工作簿中的工作表移动到另外两个打开的(新创建的)工作簿请参阅下面的代码

Question

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

Answer 1

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

Answer 2

这应该可以解决您的问题。我使用for循环来循环所有的工作表：

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 i = 1 To Workbooks(originalwb).Worksheets.Count
If Len(Worksheet.Name) > 6 And Worksheet.Name = "NMD*" Then
Workbooks(originalwb).Sheets(i).Move Before:=Workbooks(wb2name).Worksheets(Sheets.Count)

ElseIf Len(Worksheet.Name) > 6 And Worksheet.Name = "PRIME*" Then
Workbooks(originalwb).Sheets(i).Move Before:=Workbooks(wb1name).Worksheets(Sheets.Count)
ElseIf Len(Worksheet.Name) > 6 And Worksheet.Name = "MD*" Then
Workbooks(originalwb).Sheets(i).Move Before:=Workbooks(wb1name).Worksheets(Sheets.Count)
End If
'End If
Next i
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