Solved: Copy Range If Cell Value Equals

[hobbiton73]

Hi, I wonder whether someone may be able to help me please

I'm using the following code to allow users to copy a selected range from multiple Source files, amalgamating them into one Master sheet.

[VBA]Sub BigMerge()
Dim DestWB As Workbook, WB As Workbook, WS As Worksheet, SourceSheet As String
Set DestWB = ActiveWorkbook
SourceSheet = "Combined"
StartRow = 5
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("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & StartRow & ":AD" & Lastrow).Copy
DestWB.Worksheets("Combined").Cells(dr, "A").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End If
End With
WB.Close savechanges:=False
Exit For
End If
Next WS
Next N
End Sub[/VBA]

I now have a problem, which I'm really not sure how to solve. Although the macro works absolutely fine, in addition to the existing functionality, I need to be able to only copy the rows of data where the value in column E is 'Line Manager' or 'Analyst'.

I just wondered whether someone may be able to look at this please and offer a little guidance on how I may go about doing this.

Many thanks and kind regards

[patel]

[vba]Sub BigMerge()
Dim DestWB As Workbook, WB As Workbook, WS As Worksheet, SourceSheet As String
Set DestWB = ActiveWorkbook
SourceSheet = "Combined"
StartRow = 5
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("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
for j=Lastrow to 1 step -1
if range("E" & j).value <> "Line Manager" and range("E" & j).value <> "Analyst" then rows(j).delete
next
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & StartRow & ":AD" & Lastrow).Copy
DestWB.Worksheets("Combined").Cells(dr, "A").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End If
End With
WB.Close savechanges:=False
Exit For
End If
Next WS
Next N
End Sub[/vba]

[hobbiton73]

Hi @patel, thank you very much for taking the time to reply to my post and for posting the solution.

I've made the changes to my code, and although it correctly picks up the value in column E, unfortunately if there are two records, say for example in row 1 and 4 with the correct values in column E, the first record is overwritten by the second, rather than the pasting both records in the Master sheet.

Many thanks and kind regards

[patel]

attach your file for testing

[hobbiton73]

Hi @patel, thank you very much for your continued help, it is greatly appreciated.

Please find attached my test Source file. The Destination file is in exactly the same format as this

Many thanks and kind regards

[patel]

[vba]Sub BigMerge()
Dim DestWB As Workbook, WB As Workbook, WS As Worksheet, SourceSheet As String
Set DestWB = ActiveWorkbook
SourceSheet = "Combined"
StartRow = 5
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("Combined").Range("A" & Rows.Count).End(xlUp).Row + 1
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
For j = Lastrow To StartRow Step -1
If Range("E" & j).Value <> "Line Manager" And Range("E" & j).Value <> "Analyst" Then Rows(j).Delete
Next
Stop
Lastrow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & StartRow & ":AD" & Lastrow).Copy
DestWB.Worksheets("Combined").Cells(dr, "A").PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
End If
End With
WB.Close savechanges:=False
Exit For
End If
Next WS
Next N
End Sub[/vba]

[hobbiton73]

Hi @patel, thank you very much for this, but unfortunately the macro doesn't paste the rows into my 'Destination' file, instead it deletes the rows from my Source file.

Have you any ideas please where i may be going wrong.

Many thanks and kind regards

[hobbiton73]

Hi @patel, I just wanted to give you an update on this.

I decided to start from scratch and build the code again using my original and your updates, and I've now managed to get this to work.

I'm not sure whether it was a copy and paste error which caused the initial problem, but I just want to thank you for all your time and trouble, it is very much appreciated.

Kind regards