Forum Discussion

JesterGrafix's avatar
JesterGrafix
Copper Contributor
Aug 22, 2022
Solved

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

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 man...
excel
Macros and VBA
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Aug 23, 2022

    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

     

JesterGrafix's avatar
JesterGrafix
Copper Contributor
Aug 29, 2022

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

Resources