Paste filtered rows and specific columns in a new sheet

[shwetankbhardwaj]

Hello there,

I have a master worksheet which successfully import sheets and filtered data.

The problem here is, I want all the imported sheet (except master sheet) to be pasted in new worksheet name "consolidate" with specific columns and filtered rows.

Below is the coding used to import data and create a new tab (consolidate). But in addition I need:-

1. Only filtered rows. (currently getting the whole data)
2. Only A, B, C and F columns (as of now it gives all the columns)
3. Headers in all imported sheets are same, hence very first row of consolidate sheet to have headers. (no headers gets pasted)
4. If any sheet doesn't show any data and only headers are shown in any of the sheet, than coding below paste headers for that specific file.

Coding:-
Sub copyfromworksheet()

Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim rng As Range
Dim colcount As Integer

Set wrk = ActiveWorkbook

Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = "Consolidate"
Set sht = wrk.Worksheets(1)
colcount = sht.Cells(1, 255).End(xlToLeft).Column

For Each sht In wrk.Worksheets
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If

Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colcount))
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value

Next sht

trg.Columns.AutoFit

Application.ScreenUpdating = True

End Sub

Thanks in advance!

Shwetank

 

[shwetankbhardwaj]

Hello there,

Can someone please look into my query.

I really appreciate your help.