Merge Mutliple Excel Workbooks

Posted by IRHM on Stack Overflow See other posts from Stack Overflow or by IRHM
Published on 2012-12-13T17:01:34Z Indexed on 2012/12/13 17:03 UTC
Read the original article Hit count: 294

Filed under:
|

I wonder whether someone may be able to help me please.

I'm trying to use the code below to allow the user to select multiple Excel Workbooks, amalgamating the data into one 'Summary' sheet.

Sub Merge()
        Dim DestWB As Workbook, WB As Workbook, WS As Worksheet, SourceSheet As String

        Set DestWB = ActiveWorkbook
        SourceSheet = "Input"
        startrow = 7
        FileNames = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xls*),*.xls*", _
        Title:="Select the workbooks to merge.", MultiSelect:=True)
        If IsArray(FileNames) = False Then
            If FileNames = False Then
                Exit Sub
            End If
        End If
        For n = LBound(FileNames) To UBound(FileNames)
            Set WB = Workbooks.Open(Filename:=FileNames(n), ReadOnly:=True)
            For Each WS In WB.Worksheets
                If WS.Name = SourceSheet Then
                    With WS
                        If .UsedRange.Cells.Count > 1 Then
                            dr = DestWB.Worksheets("Input").Range("C" & Rows.Count).End(xlUp).Row + 1
                            lastrow = .Range("C" & Rows.Count).End(xlUp).Row
                            For j = lastrow To startrow Step -1
                            Select Case .Range("E" & j).Value
                                Case "Manager", "Lead", "Technical", "Analyst"
                                'do nothing
                                Case Else
                                .Rows(j).EntireRow.Delete
                            End Select
                            Next
                            lastrow = .Range("C" & Rows.Count).End(xlUp).Row
                             If lastrow >= startrow Then
                                .Range("B" & startrow & ":AD" & lastrow).Copy
                                DestWB.Worksheets("Input").Cells(dr, "B").PasteSpecial xlValues
                                .Range("AF" & startrow & ":AQ" & lastrow).Copy
                                DestWB.Worksheets("Input").Cells(dr, "AF").PasteSpecial xlValues
                                .Range("AS" & startrow & ":AS" & lastrow).Copy
                                DestWB.Worksheets("Input").Cells(dr, "AS").PasteSpecial xlValues
                            End If
                        End If
                    End With
                    Exit For
                End If
            Next WS
            WB.Close savechanges:=False
        Next n
    End Sub

The code works fine except for one issue which I've been trying to solve for the last few weeks.

The following line of code looks in column E of the Source file, and if any of the entries match the values shown in the code it copies that row of data to paste into the Destination file.

If Range("E" & j) <> "Manager" And Range("E"  & j) <> "Lead" And Range("E" & j) <>  "Technical" And Range("E" & j) <> "Analyst" Then Rows(j).Delete

The problem I have is that if none of these values are found in the Source file, I receive the following error:

Run time error '1004':

Delete method of range class failed

and in Debug mode it highlights this part of the line as the source of the error, but I've no idea why.

Rows(j).Delete

I just wondered whether someone may be able to look at this please and let me know where I'm going wrong, or perhaps even suggest a more efficient process of allowing the user to merge the workbooks.

Many thanks and kind regards

© Stack Overflow or respective owner

Related posts about excel-vba

Related posts about excel-2003