根据名称将工作表合并到一张工作表中

我能够在一张纸上编辑纸张，但是我想指出我要复印的纸张。 源文件可能有多个工作表名称Delta Prices #因此，如果找不到工作表名称，我想结束循环。 代码是：

  Option Explicit Sub CreateDeltaReport() Dim Newbook As Window Dim wb As Workbook Dim wb2 As Workbook Dim ws As Worksheet Dim vFile As Variant Dim wkb As Workbook Dim wb3 As Workbook Dim s As Worksheets Set wb = ThisWorkbook vFile = Application.GetOpenFilename("All-Files,*.xl**", 1, "Select One File To Open", , False) If TypeName(vFile) = "Boolean" Then Exit Sub Workbooks.Open vFile Set wb2 = ActiveWorkbook wb2.Activate Dim j As Integer Dim h As Integer On Error Resume Next Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = "Raw Delta" Sheets("Delta Prices 1").Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets("Raw Delta").Range("A1") h = 1 For Each s In ActiveWorkbook.Sheets If s.Name <> "Raw Delta" Then Do Application.GoTo Sheets("Delta Prices " & h).[a1] ' Sheet name is Delta Prices 1 Selection.CurrentRegion.Select Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select Selection.Copy Destination:=Sheets("Raw Delta").Cells(Rows.Count, 1).End(xlUp)(2) h = h + 1 ' add 1 to h so the sheet name will be "Delta Prices 2 a" Loop Until s.Name <> ("Delta Prices " & h) ' loop until Sheet name is not "Delta Prices #" End If Next End Sub 

Answer 1

像这样（未经testing）：

 Sub CreateDeltaReport() Dim wb2 As Workbook Dim vFile As Variant Dim wkb As Workbook Dim s As Worksheet Dim rd As Worksheet, rng As Range Dim h As Integer vFile = Application.GetOpenFilename("All-Files,*.xl**", 1, _ "Select One File To Open", , False) If vFile = False Then Exit Sub Set wb2 = Workbooks.Open(vFile) Set rd = wb2.Sheets.Add(After:=wb2.Sheets(wb2.Sheets.Count)) rd.Name = "Raw Delta" h = 1 Do Set s = Nothing On Error Resume Next Set s = wb2.Worksheets("Delta Prices " & h) On Error GoTo 0 If s Is Nothing Then Exit Do Else With s.Range("A1").CurrentRegion .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy _ rd.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End With End If h = h + 1 Loop End Sub