Copy from sheet1 to sheet3 with all formats

[FFaria]

Hi friends,
Need some help...
When clicking a button below code is executed, which basically, if meeting a certain criteria, copys data from sheet1 to sheet3 and then delets copied data in sheet1.
The problem is that it doesn't copy data with formats, colors, comments, etc., and I would like it to copy exactly everything.

PIC1 = Sheet1

PIC2 = Sheet3

Can you help with the code to make it do that?

Sub refresh()
'
' Macro3 Macro
'


Application.ScreenUpdating = False
y = Sheets("Folha1").Range("A7").End(xlDown).Row

For i = 7 To y
DoEvents
x = Sheets("Folha3").Range("A4").End(xlDown).Row + 1
If Sheets("Folha1").Range("AD" & i).Value = 0 And Sheets("Folha1").Range("AE" & i).Value <> 0 Then
Sheets("Folha3").Range("A" & x & ":AH" & x).Value = Sheets("Folha1").Range("A" & i & ":AH" & i).Value
Sheets("Folha3").Select
Range("A7:AH7").Select
    Selection.Copy
   Sheets("Folha3").Range("A" & x).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
Sheets("Folha1").Select
Range("AD7").Select
    Selection.Copy
   Sheets("Folha3").Select
   Range("AD" & x).Select
    
    ActiveSheet.Paste
    Application.CutCopyMode = False
      Sheets("Folha1").Select
      Range("AF7").Select
    Selection.Copy
    Sheets("Folha3").Select
    Range("AF" & x).Select
    
    ActiveSheet.Paste
    Application.CutCopyMode = False
End If

    Next i
Firstrow = 7
LastRow = y
For Lr = LastRow To Firstrow Step -1
With Sheets("Folha1").Cells(Lr, "AD")
If .Value = "0" And .Offset(0, 1) <> 0 Then .EntireRow.Delete

End With
Next Lr
x = Sheets("Folha3").Range("A4").End(xlDown).Row
ActiveWorkbook.Worksheets("Folha3").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Folha3").sort.SortFields.Add Key:=Range("A7"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Folha3").sort
        .SetRange Range("A7:AH" & x)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Application.ScreenUpdating = False
End Sub

 

[Flaiban]

I think that help you :

Sub CopySheet1toSheet3()

    'clear Sheet3
    With Worksheets("Sheet3")
        .Cells(1, 1).CurrentRegion.Clear
    End With

    With Worksheets("Sheet1")
        .Cells(1, 1).CurrentRegion.Copy _
            Destination:=Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)
    End With

End Sub

 

[FFaria]

I think that help you :

Sub CopySheet1toSheet3()

    'clear Sheet3
    With Worksheets("Sheet3")
        .Cells(1, 1).CurrentRegion.Clear
    End With

    With Worksheets("Sheet1")
        .Cells(1, 1).CurrentRegion.Copy _
            Destination:=Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)
    End With

End Sub

Thank you for trying to help, but it doesn't work along with the current code. Unless it's intended to substitute some row codes in the orginal code?