2
votes

I would like to combine my data from multiple sheets of a workbook into one sheet that I call 'combine'. Even though "Run time error '91: object variable or With block Variable not set" error came up, the code was still evaluated correctly. However, the data from the last worksheet to be pasted was still selected/highlighted.

When I debug the error, it is on the line: Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).Offset(1).Copy

How can I fix this? Thanks

Sub Combine()
'Combines columns of all sheets of a workbook into one sheet "combined"

Dim NR As Long 'starting row to paste data to combined sheet
Dim BR As Long 'length of rows of the copied data in each sheet
Dim wsNum As Long 'number of sheets in workbook
Dim wsOUT As Worksheet 'new workbook created with combined data
Dim titles() As Variant
Dim i As Long

Application.ScreenUpdating = False
On Error Resume Next
Set wsOUT = Sheets("Combine")
On Error GoTo 0

If wsOUT Is Nothing Then
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combine"
    Set wsOUT = Sheets("Combine")
End If    
wsOUT.Cells.Clear

titles() = Array("Fe Wave", "Fe Amp", "Cr Wave", "Cr Amp", "Worksheet", "", "Bin Center", "FeW Count", "FeA Count", "CrW Count", "CrA Count", "", "FeW tot", "FeA tot", "CrW tot", "CrA tot", "", "FeW%", "FeA%", "CrW%", "CrA%", "", "Int", "FeW Bino", "FeA Bino", "CrW Bino", "CrA Bino", "", "FeW Bino", "FeA Bino", "CrW Bino", "CrA Bino", "", "FeW <X>", "FeA <X>", "CrW <X>", "CrA <X>", "", "FeW std", "FeA std", "CrW std", "CrA std")

With wsOUT        
    For i = LBound(titles) To UBound(titles)
        .Cells(1, 1 + i).Value = titles(i)
    Next i

    .Rows(1).Font.Bold = True
End With

wsOUT.Activate
Range("A2").Select
ActiveWindow.FreezePanes = True
NR = 2

For wsNum = 1 To Sheets.Count
    If UCase(Sheets(wsNum).Name) <> "COMBINE" Then
        Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).Offset(1).Copy
        wsOUT.Range("A" & NR).PasteSpecial xlPasteValues
        With wsOUT
            BR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End With
        wsOUT.Range("E" & NR & ":E" & BR).Value = Sheets(wsNum).Name
        NR = BR + 1
    End If
Next wsNum

wsOUT.Columns.AutoFit
Range("A1").Select
ActiveWindow.ScrollRow = 1
Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub
1

1 Answers

1
votes

You need to see first if there is an overlap range between Sheets(wsNum).UsedRange and Sheets(wsNum).Range("BF:BI").

I added another Range object (not necessary, just easier for my debug), Dim IntRng As Range, and I set it to Set IntRng = Application.Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI")).

And at last, just check If Not IntRng Is Nothing Then.

Try replacing your For loop with the code below:

Dim IntRng As Range

For wsNum = 1 To Sheets.Count
    If UCase(Sheets(wsNum).Name) <> "COMBINE" Then
        Set IntRng = Application.Intersect(Sheets(wsNum).UsedRange, Sheets(wsNum).Range("BF:BI"))

        If Not IntRng Is Nothing Then '<-- check is IntRng successfully Set
            IntRng.Offset(1).Copy
            wsOUT.Range("A" & NR).PasteSpecial xlPasteValues

            ' the rest of your coding

        Else '<-- unable to find Intersect between the two ranges
            ' do something....
        End If

        With wsOUT
            BR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End With
        wsOUT.Range("E" & NR & ":E" & BR).Value = Sheets(wsNum).Name
        NR = BR + 1
    End If
Next wsNum