VBA to copy visible cells and paste as values in another sheet

[JesterGrafix]

I need a VBA that will copy the visible cells (I will manually filter based on dates) in columns B - F in my table and then paste them as values in another sheet starting in cell A2. I have found many types of this for auto filter, but I will be manually filtering the table based on upcoming dates.

[#2 · Accepted solution]

@JesterGrafix 

Please try this and see if this work as desired. Change the sheet references as per your requirement.

Sub CopyVisibleCells()
Dim wsSource    As Worksheet
Dim wsDest      As Worksheet
Dim lr          As Long

Application.ScreenUpdating = False
Set wsSource = ThisWorkbook.Worksheets("Sheet1")    'Source Sheet you want to copy data from
Set wsDest = ThisWorkbook.Worksheets("Sheet2")      'Destination sheet where you want to paste the data

wsDest.Range("A1").CurrentRegion.Offset(1).Columns("A:E").ClearContents 'Clearing the existing data from the destination sheet

lr = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

wsSource.Range("B2:F" & lr).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("A2").PasteSpecial xlPasteValuesAndNumberFormats

Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub

[#3]

@Subodh_Tiwari_sktneer This worked perfectly! i did make a minor change to delete the rows instead of just clear them due to some formatting happening in another vba, but otherwise it is awesome!

Sub CopyVisibleCells()
Dim wsSource    As Worksheet
Dim wsDest      As Worksheet
Dim lr          As Long

Application.ScreenUpdating = False
Set wsSource = ThisWorkbook.Worksheets("All Orders")    'Source Sheet you want to copy data from
Set wsDest = ThisWorkbook.Worksheets("Weekly Schedule")      'Destination sheet where you want to paste the data

Sheets("Weekly Schedule").Range(Sheets("Weekly Schedule").Cells(2, 6), Sheets("Weekly Schedule").Cells(2, 6).End(xlDown)).EntireRow.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
 'Clearing the existing data from the destination sheet

lr = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

wsSource.Range("B2:H" & lr).SpecialCells(xlCellTypeVisible).Copy
wsDest.Range("A2").PasteSpecial xlPasteValuesAndNumberFormats

Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub

[#4]

You're welcome @JesterGrafix! Glad it worked as desired.