Search code examples
excelvbaif-statementcopy-paste

Copy a variable number of values to another spreadsheet


I'm trying to take a range (lets say C:C), go through all the cells with value and paste them in another spreadsheet.

My target is to copy a variable number of values (because I don't know how many values I would have in C:C) to another sheet, so I have a new range with all the values (where there are no repeated values).

How to code the If statement (for a variable number of values)?

Sub Test_1()
    ' Go through each cells in the range
    Dim rg As Range
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet

    Set copySheet = Worksheets("Data")
    Set pasteSheet = Worksheets("Data_storage")

    For Each rg In Worksheets("Data").Range("C:C")

        If rg.Value = "Client 1" Then 'Instead of "Client 1" should be a variable value because "Client 1" will be a repetead value in C:C 
            copySheet.Range("C2").Copy 'Starting the counter in C2
            pasteSheet.cells(Row.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValue
        End If

    Next

End Sub

Solution

  • assuming your values in "Data" worksheet:

    • are in column "C"

    • start from row 1, with a "header"

    then you can try this code:

    Option Explicit
    
    Sub Test_1()
        Dim sourceRng As Range, pasteRng As Range, cell As Range
    
        Set pasteRng = Worksheets("Data_storage").Range("A1") '<--| set the upper-left cell in "paste" sheet
    
        With Worksheets("Data") '<--| reference "source" sheet
            Set sourceRng = .Range("D1", .Cells(.Rows.Count, "C").End(xlUp)) '<--| set the "source" range to columns "C:D" from row 1 down to last non empty cell in column "C"
        End With
    
        With sourceRng '<--| reference "source" range
            .Sort key1:=.Range("a1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, header:=xlYes '<--| sort it by its column 1 and then by its column 2
            pasteRng.Resize(.Rows.Count).value = .Resize(, 1).value '<--| paste its column 1 values to "Paste" sheet column 1
            pasteRng.CurrentRegion.RemoveDuplicates Columns:=Array(1) '<--| leave only unique values in "paste" range
            Set pasteRng = pasteRng.Range(pasteRng.Offset(1), pasteRng.End(xlDown)) '<--| skip "paste" range header
            For Each cell In pasteRng '<--| loop through unique values in "paste" range column 1
                .AutoFilter field:=1, Criteria1:=cell.value '<--| filter "source" range column 1 with current unique value
                .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Copy '<--| copy "source" range" column 2 filtered cells
                cell.Offset(, 1).PasteSpecial Transpose:=True   '<--| ... and paste/transpose them aside current unique value in "paste" range
            Next cell
            .Parent.AutoFilterMode = False '<--| .. show all rows back...
        End With
    End Sub