0

I'm trying to combine multiple sheets to one sheet and i used the following VBA code:

Sub Combine()
    Dim J As Integer
    Dim s As Worksheet

    On Error Resume Next
    Sheets("Operational").Activate
    Range("A1:A2").EntireRow.Select
    Selection.Copy Destination:=Sheets("Combined").Range("A1:A2")

    For Each s In ActiveWorkbook.Sheets
        If s.Name <> "Combined" And _
           s.Name <> "Probability & Impact" And _
           s.Name <> "Escalation Criteria" And _
           s.Name <> "Application list" And _
           s.Name <> "Dashboard" Then
            Application.GoTo Sheets(s.Name).[a1]
            Selection.CurrentRegion.Select
            ' Don't copy the headings
            Selection.Offset(2, 0).Resize(Selection.Rows.Count - 1).Select
            Selection.Copy Destination:=Sheets("Combined"). _
              Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next
      Sheets("Combined").Activate
End Sub

The file contains many tabs and i need only to combine 4 sheet to one called (Combain). The problem is the last sheet was copied three time. is any solution for that?

BigBen
  • 46,229
  • 7
  • 24
  • 40
RAZ
  • 61
  • 8
  • 1
    Start by reading [this question](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). Also remove `On Error Resume Next` - that just hides possible errors. – BigBen Jan 27 '20 at 01:33
  • Why do you list 5 sheets which you don't want instead of the 4 which interest you? Don't `Select` or `Activate` anything. `Sheets("Operational").Range("1:2").Copy Destination:=Sheets("Combined").Cells(1, 1)` will do the job of your first 4 lines of code. Remove `On Error Resume Next` so that you can see when an error occurs. – Variatus Jan 27 '20 at 03:52

1 Answers1

1

Try this piece of code, please: It should run faster than you tried, avoiding selections.

Sub Combine()
    Dim J As Integer, curReg As Range, arrCR As Variant
    Dim s As Worksheet, shComb As Worksheet, lastCombR As Long

    Set shComb = Sheets("Combined")

    Sheets("Operational").Range("A1:A2").EntireRow.Copy _
                            Destination:=shComb.Range("A1:A2")

    For Each s In ActiveWorkbook.Sheets
        If s.Name <> "Combined" And s.Name <> "Probability & Impact" And _
           s.Name <> "Escalation Criteria" And s.Name <> "Application list" And _
                                                     s.Name <> "Dashboard" Then
            Set curReg = s.Range("A1").CurrentRegion
            If curReg.Rows.count = 1 And curReg.Columns.count = 1 Then
                 MsgBox "Sheet """ & s.Name & """ does not have appropriate records to be copied..."
            Else
                arrCR = curReg.Offset(2, 0).Resize(curReg.Rows.count - 1).Value
                lastCombR = shComb.Cells(shComb.Rows.count, 1).End(xlUp)(2).Row
                shComb.Range(shComb.Cells(lastCombR, "A"), _
                    shComb.Cells(lastCombR + UBound(arrCR, 1) - 1, _
                                      UBound(arrCR, 2))).Value = arrCR
            End If
        End If
    Next
      shComb.Activate
End Sub

You can activate 'Combined' sheet from the beginning seeing what is happening. Not necessary to activate 'Operational' sheet, any more...

FaneDuru
  • 38,298
  • 4
  • 19
  • 27
  • Thanks @FaneDuru, It works good and got the right results. but i got this error: Error 1004 "Application-defined or Object-defined error" on line :arrCR = curReg.Offset(2, 0).Resize(curReg.Rows.Count - 1).Value – RAZ Jan 27 '20 at 12:07
  • Look, please on the sheet where the loop stops on error and check if there are records starting from "A1" range. In order to see the sheet name, move your cursor over the `s.Name` code and let me know what is it about. If my supposition is correct, I can make the code to skip those pages, sending a relevant message... – FaneDuru Jan 27 '20 at 12:31
  • @RAZ: I adapted the code to catch the pages not having records in the desired `s.Range("A1").CurrentRegion` – FaneDuru Jan 27 '20 at 12:43