If a comma exists in row, to copy the entire row to a sheet in another excel

[jxj_00]

Hi,

As part of my code, I need the following:

1. In Workbook Test Sheet under Sheet 1, if column B of the row contains a comma, it will be copied to Workbook Test Sheet2 under Alex. If there is no comma, it will be copied to Workbook Test Sheet2 under IMD
2. This needs to be done in a loop from row 2 to the last row. ( I am able to figure this out)

Thank you in advance for your help!

WB Attachment

 

[kevin9999]

Try the following (assumes Test Sheet 2 is open when you rune the code)

Option Explicit
Sub jxj_00()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim lr As Long
    
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks("Test Sheet 2")
    Set ws1 = wb1.Worksheets("Sheet1")
    Set ws2 = wb2.Worksheets("Alex")
    Set ws3 = wb2.Worksheets("IMD")
    
    With ws1.UsedRange
        .AutoFilter 2, "*,*"
        lr = ws2.Cells(Rows.Count, 1).End(3).Row + 1
        .Offset(1).Copy ws2.Range("A" & lr)
        .AutoFilter 2, "<>*,*"
        lr = ws3.Cells(Rows.Count, 1).End(3).Row + 1
        .Offset(1).Copy ws3.Range("A" & lr)
        .AutoFilter
    End With
End Sub

 

[Zot]

Here is another alternative

Sub CountNumberofComma()

Dim cell As Range, rngNumber As Range
Dim TestSheetWB As Workbook, TestSheet2WB As Workbook
Dim srcWS As Worksheet, AlexWS As Worksheet, IMDWS As Worksheet

Set TestSheetWB = Workbooks("Test Sheet.xlsb")
Set TestSheet2WB = Workbooks("Test Sheet 2.xlsb")

Set srcWS = TestSheetWB.Sheets("Sheet1")
Set AlexWS = TestSheet2WB.Sheets("Alex")
Set IMDWS = TestSheet2WB.Sheets("IMD")

Set rngNumber = srcWS.Range("B2", srcWS.Cells(Rows.Count, "B").End(xlUp))

For Each cell In rngNumber
    If cell Like "*,* " Then
        srcWS.Range("A" & cell.Row, "E" & cell.Row).Copy AlexWS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    Else
        srcWS.Range("A" & cell.Row, "E" & cell.Row).Copy IMDWS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    End If
Next

End Sub