Autofill down from last filled cell in column to last filled row in next column

[GuyHudson83]

Hi,

I was hoping someone might be able to help I am trying to fill copy the name of a category from one sheet (GOBACK) and paste into the next available cell in column D then copy down as far as the last populated cell in column e (for example if I was to do this without a macro i would double click the bottom right corner of the cell to fill down)

The ranges will need to vary as it works down through the categories. This is what I have so far..

    Sheets("DATA STORE").Select
    Range("D5").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    lastRow = ActiveWorkbook.UsedRange.End(xlDown).Row
    Range(ActiveCell + CStr(lastRow)).PasteSpecial xlPasteAll
    RangeActivecell.Copy Range(ActiveCell + CStr(lastRow))

Any help very gratefully received

Thanks,

Guy

 

[Ralajer]

Welcome to the board Guy,

The below code should meet your requirements I am not sure how you were setting the category to copy so I just made it a static reference to cell A1 on the GOBACK sheet. The entire range can be filled in one copy and paste operation.

Sub fillCol()
    Dim FFR As Long
    Dim LR As Long
    Dim outCol As Integer
    Dim matchCol As Integer
    
    Dim copyCell As Range
    Dim fillRng As Range
    
'// Example category cell to copy from
    '// Range to be copied on other sheet
    Set copyCell = Sheets("GOBACK").Range("A1")
    
    '// Set the output column by Changing cell reference
    outCol = Columns("D").Column
    '// Set the match column by Changing cell reference
    matchCol = Columns("E").Column
    
    With Sheets("DATA STORE")
        '// First Free Row in column as specified in outCol
        FFR = .Cells(.Rows.Count, outCol).End(xlUp).Row + 1
        '// Last Row in match to column as specified in matchCol
        LR = .Cells(.Rows.Count, matchCol).End(xlUp).Row

        '// If the First Free Row in fill column row is greater than or equal to
        '//  the  Last Row in match to column then exit sub.
        If FFR >= LR Then Exit Sub
        
        '// Set the range to fill in output column from the First Free Row
        '//  to Last Row
        Set fillRng = .Range(.Cells(FFR, outCol), .Cells(LR, outCol))
    End With
    '// Copy Category to the fill range
    copyCell.Copy fillRng
End Sub

Let me know if you have any questions about the code.