Hi, i would like to copy data (with filtered) to another sheet. But unable to do so; either no data was copy / the data wasn't filtered.
In tab Case Details, i want to filter the data at column F with "Update to progress" at first, before i start copy selected range to another new sheet.
Below is the VBA i get from previous post i've read and i try it by myself. Please guide me if any:
Sub AutoFilter_RangeCopy_Row()
' Get the worksheets
Dim shRead As Worksheet, shWrite As Worksheet
Set shRead = ThisWorkbook.Worksheets("Case Details")
Set shWrite = ThisWorkbook.Worksheets("Pivot")
Dim lastCol As Long
' Get the range
Dim rg As Range
Set rg = shRead.Range("F1").CurrentRegion
' Remove any existing filters
rg.AutoFilter
' Apply the Autofilter
rg.AutoFilter Field:=6, Criteria1:="*Update to progress*"
' Copy Range & Paste Special that match Headers only
Application.ScreenUpdating = False
Dim LastRow As Long, header As Range, foundHeader As Range, lCol As Long, srcWS As Worksheet, desWS As Worksheet
Set srcWS = Sheets("Case Details")
Set desWS = Sheets("Pivot")
LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = desWS.Cells(1, Columns.Count).End(xlToLeft).Column
For Each header In desWS.Range(desWS.Cells(1, 1), desWS.Cells(1, lCol))
Set foundHeader = srcWS.Rows(1).Find(header, LookIn:=xlValues, lookat:=xlWhole)
If Not foundHeader Is Nothing Then
srcWS.Range(srcWS.Cells(2, foundHeader.Column), srcWS.Cells(LastRow, foundHeader.Column)).Copy desWS.Cells(2, header.Column)
End If
Next header
Application.ScreenUpdating = True
End Sub
In tab Case Details, i want to filter the data at column F with "Update to progress" at first, before i start copy selected range to another new sheet.
Below is the VBA i get from previous post i've read and i try it by myself. Please guide me if any:
Sub AutoFilter_RangeCopy_Row()
' Get the worksheets
Dim shRead As Worksheet, shWrite As Worksheet
Set shRead = ThisWorkbook.Worksheets("Case Details")
Set shWrite = ThisWorkbook.Worksheets("Pivot")
Dim lastCol As Long
' Get the range
Dim rg As Range
Set rg = shRead.Range("F1").CurrentRegion
' Remove any existing filters
rg.AutoFilter
' Apply the Autofilter
rg.AutoFilter Field:=6, Criteria1:="*Update to progress*"
' Copy Range & Paste Special that match Headers only
Application.ScreenUpdating = False
Dim LastRow As Long, header As Range, foundHeader As Range, lCol As Long, srcWS As Worksheet, desWS As Worksheet
Set srcWS = Sheets("Case Details")
Set desWS = Sheets("Pivot")
LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lCol = desWS.Cells(1, Columns.Count).End(xlToLeft).Column
For Each header In desWS.Range(desWS.Cells(1, 1), desWS.Cells(1, lCol))
Set foundHeader = srcWS.Rows(1).Find(header, LookIn:=xlValues, lookat:=xlWhole)
If Not foundHeader Is Nothing Then
srcWS.Range(srcWS.Cells(2, foundHeader.Column), srcWS.Cells(LastRow, foundHeader.Column)).Copy desWS.Cells(2, header.Column)
End If
Next header
Application.ScreenUpdating = True
End Sub