Copy data from one sheet to another based on value of a cell

[Dr L0L]

Morning all

A bit of a novice with Excel but I've been tasked with copying data from one Worksheet to another based on the value of a cell in the original worksheet.

So in Column B, any cell with "Monies from Client" along with corresponding data in the same row under Column C, D and E would need to be copied to another worksheet.

I've tried to create a macro in VBA using the following but I just cannot get it to work:

Sub Monies()
If Worksheets("Overall Cash Account")!$B$4 = "Monies from Client" Then
Worksheets("Overall Cash Account").Range("A4:D4").Copy
destination: Worksheets("Payments from Client").Range ("A4:D4")
End If
End Sub

Would anyone know the formula for the same, outside of VBA, or where I'm going wrong on VBA?

Any help is very much appreciated!

- Liam

 

[JackDanIce]

Welcome to the board. Try:

Sub Monies()
    
    With Sheets("Overall Cash Account")
        If .Range("B4").Value = "Monies from Client" Then 
            Sheets("Payments from Client").Range("A4:D4").Value = .Range("A4:D4").Value
        End If
    End With       
        
End Sub

 

[Dr L0L]

Hi Jack

Cheers - Looks like it should work.

I've created a new Macro and gave it a whirl - no error messages but the data doesn't appear on the worksheet where it is to be pasted.

Any ideas? I must be doing something wrong here!

Cheers.

 

[JackDanIce]

Not sure without seeing your file. Check the worksheet names match exactly to the code (e.g. Case or spaces etc). I tested using "sheet1" and "sheet2" substituted for "Overall Cash Account" and "Payments from Client" without problem - that is the data copied across exactly from A4:D4 to A4:D4

 

[Dr L0L]

I've changed the sheet names just to ebb out any errors - it worked!

Is there a way to reference the entire original sheet rather than the cell range A4:D4?

So if any cell in column B contained 'Monies from Client' it would copy all the data on that row to the separate sheet?

Many thanks, Jack, you've been a big help!

 

[JackDanIce]

Change the sheet names and this assumes you have headers in row 1 of both sheets:

Sub Monies_v2()
        
Dim x       As Long

Dim srcWks  As Excel.Worksheet
Dim destWks As Excel.Worksheet

Dim rngData As Excel.Range
Dim rng     As Excel.Range

Const str1  As String = "Monies from Client"


    Set srcWks = Sheets("Overall Cash Account")   'Source sheet
    Set destWks = Sheets("Payments from Client")  'Destination sheet
            
    Application.ScreenUpdating = False
    
    With srcWks
        
        If .AutoFilterMode Then .AutoFilterMode = False
        
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
                   
        Set rngData = .Range("A1").Resize(x)
                   
        With rngData.Resize(, 4)
            .AutoFilter
            .AutoFilter field:=2, Criteria1:=str1
        End With
        
        For Each rng In rngData.Offset(1).Resize(x - 1).SpecialCells(xlCellTypeVisible)
            destWks.Cells(rng.Row, 1).Resize(, 4).Value = rng.Resize(, 4).Value
        Next rng
        
        .AutoFilterMode = False

    End With
        
    Set srcWks = Nothing
    Set destWks = Nothing
    Set rngData = Nothing
        
    Application.ScreenUpdating = True
      
End Sub

 

[Dr L0L]

Hi Jack

Yeah I've put some headers in row 1 - code seems to work but for some reason only picking up 5 entries and I'm counting over 100 in the original sheet.

Would it be possible to copy over data from column E also from the worksheet?

Sorry for all the hassle!

 

[JackDanIce]

The code does the following:

Checks the source worksheet does not have a filter turned on
Finds the last used row based on Column A in the source worksheet (x)
Filters the source worksheet (area is A1:D & x) by looking in column 2 (B) for value "Monies from Client"
Loops through the filtered results and copies the data from A:D to the equivalent row in the destination worksheet
Turns the filter off on the source worksheet.

If it's only copied 5 records, you may need to check your column A or column B on the source worksheet.

To extend to column E (blue = edits to code):

Sub Monies_v3()
        
Dim x       As Long

Dim srcWks  As Excel.Worksheet
Dim destWks As Excel.Worksheet

Dim rngData As Excel.Range
Dim rng     As Excel.Range

Const str1  As String = "Monies from Client"


    Set srcWks = Sheets("Overall Cash Account")   'Source sheet
    Set destWks = Sheets("Payments from Client")  'Destination sheet
            
    Application.ScreenUpdating = False
    
    With srcWks
        
        If .AutoFilterMode Then .AutoFilterMode = False
        
        x = .Cells(.Rows.Count, 2).End(xlUp).Row 'Find last row on column B
                   
        Set rngData = .Range("B1").Resize(x) 'Filter only column B for value "Monies from Client"
                   
        With rngData
            .AutoFilter
            .AutoFilter field:=1, Criteria1:=str1
        End With
        
        For Each rng In rngData.Offset(1).Resize(x - 1).SpecialCells(xlCellTypeVisible)
            destWks.Cells(rng.Row, 1).Resize(, 5).Value = rng.Offset(,-1).Resize(, 5).Value 'Extending from A:D to A:E to capture column E values
        Next rng
        
        .AutoFilterMode = False

    End With
        
    Set srcWks = Nothing
    Set destWks = Nothing
    Set rngData = Nothing
        
    Application.ScreenUpdating = True
      
End Sub