Copy partial row based on cell value in to sheets

greenestdays · Nov 6th 2022

Hi, I have looked but I am so new to this I don't have much of a clue if it doesn't relate to the code I have which is below.

I want to copy Columns A to BR in to the MG sheet if BR has a Y in it.

Ideally I would love to have something which would look up a range of columns in the Master Data sheet then copy in to the relevant sheet. I hope I have made some sense!

Code

Sub MoveRowBasedOnCellValueMGM()

    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Master data").UsedRange.Rows.Count
    J = Worksheets("MG").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("MG").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Master data").Range("BR2:BR" & I)
    
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Y" Then
            xRg(K).Copy range("A:BP").Copy Destination:=Worksheets("MG").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Display More

vcoolio · Nov 8th 2022

Hello Greenestdays,

Automating the autofilter should do the task for you and be much quicker than a looping construct. Hence, try the following:-

Code

Sub Test()

    Dim wsMD As Worksheet, wsMG As Worksheet
    Set wsMD = Sheets("Master Data")
    Set wsMG = Sheets("MG")
    
    Application.ScreenUpdating = False
    
    With wsMD.[A1].CurrentRegion
            .AutoFilter 70, "Y"
            .CurrentRegion.Offset(1).Copy wsMG.Range("A" & Rows.Count).End(3)(2)
            .AutoFilter
    End With
    
    Application.ScreenUpdating = True

End Sub

Display More

I hope that this helps.

Cheerio,

vcoolio.

RAJESH SHAH · Nov 8th 2022

I had a similar query solved. But you will have to edit the code and get the rows containing Y in the sheet required. I have 3 conditions in the code to get the data from one sheet to another. You can edit the code by changing the name of the sheet and the condition you are looking for. Hope it helps.

Code

Sub Create_Not_imported()
    Application.ScreenUpdating = False                                                          ' Turn ScreenUpdating off
    Application.DisplayAlerts = False                                                           ' Turn DisplayAlerts off ... sheet deletion causes popup

Dim ar1, ar2, arr
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Sheets("B2B")
Set ws2 = Sheets("Not Imported")


lr = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ar1 = ws1.Range("A1:X" & lr)    ' Get data from "B2B"

ReDim arr(1 To UBound(ar1, 2), 1 To 1)  ' Dimension output array (for "Not imported")

n = 0
For R = 7 To UBound(ar1, 1)    'Loop through B2B Data

    If ar1(R, 1) = "" Then GoTo nextr
     
    tax = ar1(R, 10) + ar1(R, 11) + ar1(R, 12) + ar1(R, 13) ' check Taxes are 0
     
    If tax = 0 Or Left(ar1(R, 8), 1) = "Y" Or ar1(R, 6) = ar1(R, 10) Then
     
        n = n + 1
        ReDim Preserve arr(1 To UBound(ar1, 2), 1 To n)
        For c = 1 To UBound(ar1, 2) ' Store data in ouput array
            arr(c, n) = ar1(R, c)
        Next c
        
    End If
     
nextr:
Next R

ws2.[a7].Resize(UBound(arr, 2), UBound(arr, 1)) = Application.Transpose(arr)
     Application.ScreenUpdating = True                                                       ' Turn ScreenUpdating off
    Application.DisplayAlerts = True
  
End Sub

Display More

Copy partial row based on cell value in to sheets

Participate now!

Share

Similar Threads

How to run a formula on a cell I want to copy in VBA

VBA - Highlight Entire Row - Based on Duplicate

Copy specific cell data to summary tab based on tab name

VBA copy data from multiple workbooks based on criteria

How to Relocate a row of cells automatically based on the value in the cell

Select Cells in a Row based on column header