Hi Folks,
I am trying to make a macro to separate material from column B into different worksheets based on certain criteria that i have set.
For example if my column B begins with 070 or 10 or 90, i want them cut and pasted to another worksheet as they are a sub account of welshflex workcell. Also if column A is of from 0100, 0300, 0400 location from column A, i want the macro to ignore them.
Newbie macro user here...This is what i have so far and i am running into a type mismatch error:
Dim i As Long, lastrow1 As Long
Dim myname As Double
lastrow1 = Sheets("sheet1").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
myname = "070*" Or "90*" Or "10*"
Sheets("sheet1").Activate
If Sheets("sheet1").Cells(i, "B").Value = myname Then
Sheets("sheet1").Activate
Sheets("sheet1").Range(Cells(i, "A"), Cells(i, "H")).Copy
Sheets("sheet2").Activate
Sheets("sheet2").Range(Cells(i, "A"), Cells(i, "H")).Select
ActiveSheet.Paste
End If
Application.CutCopyMode = False
Next i
Sheets("sheet1").Activate
Sheets("sheet1").Range("A1").Select
End Sub
Hi Eric
Some problems in your vba code myname is a string not Double you don't need to select cells slows the routine down
You could use the same routine with some mods what i did for David Wells
Do you want the whole row copied or just certain cells to sheet 2 ?
Rob
Eric
You could try this, not tested and also col B does not comply with what you have asked for
Sub transfer()
Dim i As Long, lastrow1 As Long
Dim MyName As String
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
With ws
lastrow1 = Sheets("sheet1").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
MyName = Left(.Cells(i, "B"), 3)
Select Case MyName
Case "010" And .Range("A" & i).Value <> "0100" Or .Range("A" & i).Value <> "0300" Or .Range("A" & i).Value <> "0400"
.Range("A" & i & ":H" & i).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Case "070" And .Range("A" & i).Value <> "0100" Or .Range("A" & i).Value <> "0300" Or .Range("A" & i).Value <> "0400"
.Range("A" & i & ":H" & i).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Case "090" And .Range("A" & i).Value <> "0100" Or .Range("A" & i).Value <> "0300" Or .Range("A" & i).Value <> "0400"
.Range("A" & i & ":H" & i).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End Select
Next i
End With
End Sub
Eric
this is a lot faster ok
Rob
Thank you all! you were all really helpful
