Copy Visible Range and paste to Visible Range of another sheet

[arihan1511]

I have a database in sheet 2 which has certain rows hidden.I want to copy this data to sheet 1 which also has certain rows hidden but hidden rows are different on both sheets.
I have this macro which copies visible data from sheet2 to sheet 1 then sheet1 printout is taken but since hidden rows are different in both sheets ,certain rows of sheet 2 are not visible on sheet 1

Sub CopyRangevisible()
Sheets("Sheet2").Range("A2:F20").SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("Sheet1").Range("A2")
End Sub

I tried by modifyng line Destination:=Sheets("Sheet1").Range("A2").SpecialCells(xlCellTypeVisible) but its not working
Even macro recorded code not working
Pl note hidden rows are not constant and they differ each time data is copied

Can anyone help me in getting a working code to Copy Visible Range from sheet2 and paste to Visible Range of Sheet1

 

[David Evans]

Why are the rows hidden on Sheet1 and Sheet2?

Have you thought about holding your data in a table, so that you can use filtering to hide/unhide.

 

[arihan1511]

In Future I plan to add some data in column G onwards wherein blank rows will be hidden in both sheets hence this issue

 

[Nebu]

Hi:

Try the following code.

Sub CopyHidden()
Application.ScreenUpdating = False

Dim i, j, k, m, n As Long

i = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
k = Sheet1.Range("A1").SpecialCells(xlCellTypeVisible).Row + 1

For j = i To 2 Step -1
    If Sheet2.Rows(j).Hidden = False Then
        Sheet2.Rows(j).Copy
                If Sheet1.Rows(k).Hidden = False Then
                  Sheet1.Range("A" & k).PasteSpecial
                  Application.CutCopyMode = False
                End If
        m = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
        n = Sheet1.Range("A" & m).Row
                Do While Cells(n + 1, 1).EntireRow.Hidden = True
                    n = n + 1
                Loop
        k = n + 1
    End If
 
Next

If Sheet2.Range("A" & j) = vbNullString Then End

Application.ScreenUpdating = True
End Sub

Thanks

 

[arihan1511]

Thanks for prompt reply Nebu
code is successfully copying from one visible to another visible range
but destination sheet1 is showing data in reverse order
ie if ID in Sheet 2 column A is 1,2,3,4 ..... then copied range is .....4,3,2,1
can you correct this

Also I want to restrict copy Paste range to A2:F20 instead of entire sheet
Thanks

 

[Nebu]

Hi:

Use the following code.

Sub CopyHidden()
Application.ScreenUpdating = False

Dim i, j, k, m, n As Long

i = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
k = Sheet1.Range("A1").SpecialCells(xlCellTypeVisible).Row + 1

For j = 2 To i
    If Sheet2.Rows(j).Hidden = False Then
        Sheet2.Rows(j).Copy
                If k > 20 Then
                MsgBox "Row Limit reached cannot paste beyond row 20.", vbCritical, "Row Limit"
                Exit Sub
                End If
                If Sheet1.Rows(k).Hidden = False Then
                  Sheet1.Range("A" & k).PasteSpecial
                  Application.CutCopyMode = False
                End If
        m = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
        n = Sheet1.Range("A" & m).Row
                Do While Cells(n + 1, 1).EntireRow.Hidden = True
                    n = n + 1
                Loop
        k = n + 1
    End If
 
Next

If Sheet2.Range("A" & j) = vbNullString Then End

Application.ScreenUpdating = True
End Sub

If the row no is greater than 20 the code will throw a warning message and will end the sub routine. I have fixed the reverse issue, in the for loop I had given Step -1 forgot to change it. you can change the content of the message box as per your requirement.

Thanks

 

[arihan1511]

Its working Great
Thanks for solution

 

[tomhouy]

If you're copying and pasting the data manually, there is already a method to do this in Excel without the need for Macros btw:

https://support.office.com/en-in/ar...lls-only-d8b76986-2d1e-4d59-a01e-0d8c68ca5379