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

jxj_00

New Member
Joined
Oct 1, 2020
Messages
24
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Try the following (assumes Test Sheet 2 is open when you rune the code)

VBA 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
 
Upvote 0
Here is another alternative
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,106
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top