VBA Copy and Paste to different sheets based on conditions

[steph02]

Hi,

I have been working on this VBA and I cannot get it to work.

The aim of this is to move information onto 3 different excel sheets based on conditions. So, If column "A" States Whiston manu OR Whiston Laser OR Whiston Turning AND Column "B" states Yes AND Colunm "L" States Yes it will copy it's self onto a Whiston Manu sheet.

The same applies for the UK Manu sheet and the Non-UK Manu Sheet, but both have different column A words as you can see in the VBA.

I have no idea where I am going wrong, any help or even a new VBA would be very much appreciated. This is what I have so far

Sub Button7_Click()
lastRow = Worksheets("BOM").Range("A" & Rows.Count).End(xlUp).Row

For r = 10 To lastRow
If Worksheets("BOM").Range("A" & r).Value = "WHISTON MANU" Or Worksheets("BOM").Range("A" & r).Value = "WHISTON LASER" Or Worksheets("BOM").Range("A" & r).Value = "WHISTON TURNING" And _
Worksheets("BOM").Range("B" & r).Value = "YES" And _
Worksheets("BOM").Range("L" & r).Value = "YES" Then

Worksheets("BOM").Range("A" & r & ",D" & r & ",E" & r & ",F" & r & ",G" & r & ",J" & r).Copy

Worksheets("WHISTON MANU").Activate
lastRowRpt = Worksheets("WHISTON MANU").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("WHISTON MANU").Range("A" & lastRowRpt + 1).Select

ActiveSheet.Paste

Else

If (Worksheets("BOM").Range("A" & r).Value = "UK MANU" Or Worksheets("BOM").Range("A" & r).Value = "UK LASER" Or Worksheets("BOM").Range("A" & r).Value = "UK TURNING") And _
Worksheets("BOM").Range("B" & r).Value = "YES" And _
Worksheets("BOM").Range("L" & r).Value = "YES" Then

Worksheets("BOM").Range("A" & r & ",D" & r & ",E" & r & ",F" & r & ",G" & r & ",J" & r).Copy

Worksheets("UK MANU").Activate
lastRowRpt = Worksheets("UK MANU").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("UK MANU").Range("A" & lastRowRpt + 1).Select

ActiveSheet.Paste

Else

If Worksheets("BOM").Range("A" & r).Value = "NON-UK MANU" And _
Worksheets("BOM").Range("B" & r).Value = "YES" And _
Worksheets("BOM").Range("L" & r).Value = "YES" Then

Worksheets("BOM").Range("A" & r & ",D" & r & ",E" & r & ",F" & r & ",G" & r & ",J" & r).Copy

Worksheets("NON-UK MANU").Activate
lastRowRpt = Worksheets("NON-UK MANU").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("NON-UK MANU").Range("A" & lastRowRpt + 1).Select

ActiveSheet.Paste

End If
End If
End If

Next r

End Sub

 

[HighAndWilder]

Hi,

I have been working on this VBA and I cannot get it to work.

The aim of this is to move information onto 3 different excel sheets based on conditions. So, If column "A" States Whiston manu OR Whiston Laser OR Whiston Turning AND Column "B" states Yes AND Colunm "L" States Yes it will copy it's self onto a Whiston Manu sheet.

The same applies for the UK Manu sheet and the Non-UK Manu Sheet, but both have different column A words as you can see in the VBA.

I have no idea where I am going wrong, any help or even a new VBA would be very much appreciated. This is what I have so far

Sub Button7_Click()
lastRow = Worksheets("BOM").Range("A" & Rows.Count).End(xlUp).Row

For r = 10 To lastRow
If Worksheets("BOM").Range("A" & r).Value = "WHISTON MANU" Or Worksheets("BOM").Range("A" & r).Value = "WHISTON LASER" Or Worksheets("BOM").Range("A" & r).Value = "WHISTON TURNING" And _
Worksheets("BOM").Range("B" & r).Value = "YES" And _
Worksheets("BOM").Range("L" & r).Value = "YES" Then

Worksheets("BOM").Range("A" & r & ",D" & r & ",E" & r & ",F" & r & ",G" & r & ",J" & r).Copy

Worksheets("WHISTON MANU").Activate
lastRowRpt = Worksheets("WHISTON MANU").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("WHISTON MANU").Range("A" & lastRowRpt + 1).Select

ActiveSheet.Paste

Else

If (Worksheets("BOM").Range("A" & r).Value = "UK MANU" Or Worksheets("BOM").Range("A" & r).Value = "UK LASER" Or Worksheets("BOM").Range("A" & r).Value = "UK TURNING") And _
Worksheets("BOM").Range("B" & r).Value = "YES" And _
Worksheets("BOM").Range("L" & r).Value = "YES" Then

Worksheets("BOM").Range("A" & r & ",D" & r & ",E" & r & ",F" & r & ",G" & r & ",J" & r).Copy

Worksheets("UK MANU").Activate
lastRowRpt = Worksheets("UK MANU").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("UK MANU").Range("A" & lastRowRpt + 1).Select

ActiveSheet.Paste

Else

If Worksheets("BOM").Range("A" & r).Value = "NON-UK MANU" And _
Worksheets("BOM").Range("B" & r).Value = "YES" And _
Worksheets("BOM").Range("L" & r).Value = "YES" Then

Worksheets("BOM").Range("A" & r & ",D" & r & ",E" & r & ",F" & r & ",G" & r & ",J" & r).Copy

Worksheets("NON-UK MANU").Activate
lastRowRpt = Worksheets("NON-UK MANU").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("NON-UK MANU").Range("A" & lastRowRpt + 1).Select

ActiveSheet.Paste

End If
End If
End If

Next r

End Sub

Give this a go.

Place this code in a workbook code module and run the subMain procedure.

Do it on a copy of your data.

Private Sub subMain()
Dim arr() As Variant

  ActiveWorkbook.Save

  arr = Array("WHISTON MANU", "WHISTON LASER", "WHISTON TURNING")
  Call subFilterAndCopyData(arr, "WHISTON MANU")
  
  arr = Array("UK MANU", "UK LASER", "UK TURNING")
  Call subFilterAndCopyData(arr, "UK MANU")
  
  arr = Array("NON-UK MANU")
  Call subFilterAndCopyData(arr, "NON-UK MANU")
  
  If WsBOM.AutoFilterMode Then
    WsBOM.ShowAllData
    WsBOM.AutoFilterMode = False
  End If
  
  ActiveWorkbook.Save

End Sub

Private Sub subFilterAndCopyData(arr As Variant, strDest As String)
Dim WsDest As Worksheet
Dim WsBOM As Worksheet
Dim lngLastRow As Long

  Set WsBOM = Worksheets("BOM")
  
  If WsBOM.AutoFilterMode Then
    WsBOM.ShowAllData
    WsBOM.AutoFilterMode = False
  End If
  
  lngLastRow = WsBOM.Cells(Rows.Count, "A").End(xlUp).Row
  
  With WsBOM.Range("A1").CurrentRegion
  
    .AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues

    .AutoFilter Field:=2, Criteria1:="Yes"
    
    .AutoFilter Field:=12, Criteria1:="Yes"

  End With
  
  Set WsDest = Worksheets(strDest)
  
  WsBOM.Range("A2:A" & lngLastRow).SpecialCells(xlCellTypeVisible).Copy _
    WsDest.Range("A" & Rows.Count).End(3)(2)
  
  WsBOM.Range("D2:G" & lngLastRow).SpecialCells(xlCellTypeVisible).Copy _
    WsDest.Range("D" & Rows.Count).End(3)(2)
  
  WsBOM.Range("J2:J" & lngLastRow).SpecialCells(xlCellTypeVisible).Copy _
    WsDest.Range("J" & Rows.Count).End(3)(2)
    
  WsDest.Cells.EntireColumn.AutoFit
  
  Application.CutCopyMode = False
  
End Sub