CODEWITHSUNDEEP
vbaexcel
AnotherCuriousKid
AnotherCuriousKid

Reputation: 101

Combining sheets into one sheet based on name

I was able to compile the sheets in one sheet however I would like to indicate the sheets I want to copy. The source file may have multiple sheets name Delta Prices # therefore I would like to end the loop once it cannot find the sheet's name. Code is:

  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

Upvotes: 0

Views: 135

Answers (1)

Tim Williams
Tim Williams

Reputation: 166146

Something like this (untested):

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

Upvotes: 1

Related Questions