Question

我能够在一张纸上编辑纸张但是我想指出我要复印的纸张。源文件可能有多个工作表名称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

像这样（未经测试）：

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

根据名称将纸张合并为一张纸

1 个答案: