Copy Visible Rows

[adamsm]

The following line of code copies column content of "F" from the sheet "Orders" and pastes them in column "E" of the sheet "Data".

How could I make the code to copy only the visible rows from the column in case when the sheet is filtered?

Any help on this would be kindly appreciated.
OrdersWks.Range("F16:F" & m).Copy
DataWks.Range("E" & r & ":E" & (r + m - 16)).PasteSpecial Paste:=xlPasteValues

[Kenneth Hobs]

You can adapt this.
Sheet1.Range("F1:F10").SpecialCells(xlCellTypeVisible).Copy
Sheet2.Range("E1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

[adamsm]

Thanks for the reply Kenneth. To understand my problem better I've attached a sample workbook.

In this sample workbook I've incorporated the line you've suggested. But it does not seem to get what I want.

Suppose if you run the macro by filtering the "memos" sheet to "OUT" it will copy the visible rows, but copies the date and invoice serial number to extra rows.

How could I avoid this; meaning how to make the code to copy date and invoice serial to the number of rows where data is copied from the "memos sheet".

And also how could I prevent the code from clearing the column contents of the sheet "memos"

Any help on this would be kindly appreciated.

[Kenneth Hobs]

Change your logic to what I did.

e.g.
Change:
' Copy Customer ID as values
NewMemoWks.Range("E17:E" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("F" & r & ":F" & (r + m - 17)).PasteSpecial Paste:=xlPasteValues


To:
' Copy Customer ID as values
NewMemoWks.Range("E17:E" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("F" & r).PasteSpecial Paste:=xlPasteValues


For the parts about adding the Invoice Serial and Invoice Date, you need to use another method where the number of visible rows are counted. For the part about not clearing the contents, then don't do it. I commented it out. For more full details see:
Sub SaveData()
Application.ScreenUpdating = False

Dim r As Long
Dim m As Long
Dim n As Long

Dim NewMemoWks As Worksheet
Dim OrderWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

'cells to copy from Memos sheet - some contain formulas
myCopy = "E8,O6"

Set NewMemoWks = Worksheets("Memos")
Set OrderWks = Worksheets("OrderData")

With NewMemoWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the fields!", vbExclamation, "Save Order"
Exit Sub
End If
End With

' Use column N
m = NewMemoWks.Range("N" & NewMemoWks.Rows.Count).End(xlUp).Row
' Headers are now in row 4
If m = 16 Then
MsgBox "No data", vbExclamation
Exit Sub
End If

r = OrderWks.Range("E" & OrderWks.Rows.Count).End(xlUp).Row + 1
' Copy Serial
NewMemoWks.Range("D17:D" & m).SpecialCells(xlCellTypeVisible).Copy Destination:=OrderWks.Range("E" & r)

' Copy Customer Name
NewMemoWks.Range("N17:N" & m).SpecialCells(xlCellTypeVisible).Copy Destination:=OrderWks.Range("O" & r)

' Copy Customer ID as values
NewMemoWks.Range("E17:E" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("F" & r).PasteSpecial Paste:=xlPasteValues

' Copy Bill # as values
NewMemoWks.Range("F17:F" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("G" & r).PasteSpecial Paste:=xlPasteValues

' Copy Bill Date as values
NewMemoWks.Range("G17:G" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("H" & r).PasteSpecial Paste:=xlPasteValues

' Copy User as values
NewMemoWks.Range("H17:H" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("I" & r).PasteSpecial Paste:=xlPasteValues

' Copy Request No as values
NewMemoWks.Range("I17:I" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("J" & r).PasteSpecial Paste:=xlPasteValues

' Copy Category as values
NewMemoWks.Range("J17:J" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("K" & r).PasteSpecial Paste:=xlPasteValues

' Copy Insurance Policy as values
NewMemoWks.Range("K17:K" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("L" & r).PasteSpecial Paste:=xlPasteValues

' Copy Location as values
NewMemoWks.Range("L17:L" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("M" & r).PasteSpecial Paste:=xlPasteValues

' Copy Pay Type as values
NewMemoWks.Range("M17:M" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("N" & r).PasteSpecial Paste:=xlPasteValues

' Copy Address as values
NewMemoWks.Range("O17:O" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("P" & r).PasteSpecial Paste:=xlPasteValues

' Copy Total as values
NewMemoWks.Range("P17:P" & m).SpecialCells(xlCellTypeVisible).Copy
OrderWks.Range("Q" & r).PasteSpecial Paste:=xlPasteValues


'Number of visible rows
n = NewMemoWks.Range("P17:P" & m).SpecialCells(xlCellTypeVisible).Rows.Count
' Copy Invoice Serial number
OrderWks.Range("D" & r).Resize(n, 1).Value2 = NewMemoWks.Range("O6").Value2

' Copy Date
NewMemoWks.Range("E8").Copy Destination:=OrderWks.Range("C" & r)


OrderWks.Range("C5:Q5").Copy
'Note Resizing.
OrderWks.Range("C" & r).Resize(n, 15).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False


With NewMemoWks.Range("O6")
.Value = .Value + 1
End With

NewMemoWks.Range("E8").ClearContents
'clear input cells that contain constants
With NewMemoWks
On Error Resume Next
With .Range("E8").Cells.SpecialCells(xlCellTypeConstants)
'.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

[adamsm]

Thanks for the help Kenneth. If I may ask for one more help; I would be pleased with that.

At present the code does copy the contents of the columns & individual cells to the sheet OrderData.

But in doing so, if the sheet is not filtered it copies the Invoice date to the first data row of the copied rows. And if the sheet is filtered the code copies the invoice date and the invoice serial number only to the first row of the copied data.

Meaning it does not keep on copying the invoice serial and date to the last copied data row.

I would be happy if you could help me to figure out a way to copy the invoice date and serial number from the first to the last data row of the copied column, when the macro is run and avoid the clearing of the cells "E8"

Any help on this would be kindly appreciated.

Thanks in advance.

[Kenneth Hobs]

It works fine for me. Filter should not make any difference.

In the last code, I showed how to add Invoice Serial. This code shows how to do it for the Invoice Serial and Invoice Date or what you call Copy Date.
'Number of visible rows
n = NewMemoWks.Range("P17:P" & m).SpecialCells(xlCellTypeVisible).Rows.Count
' Copy Invoice Serial number
OrderWks.Range("D" & r).Resize(n, 1).Value2 = NewMemoWks.Range("O6").Value2

' Copy Date
'NewMemoWks.Range("E8").Copy Destination:=OrderWks.Range("C" & r)
OrderWks.Range("C" & r).Resize(n, 1).Value2 = NewMemoWks.Range("E8").Value2

[adamsm]

I've attached a copy of the current workbook. And I've highlighted the copied rows to the order data sheet.

Date & serial gets copied to the first copied data row.

I would be happy if you could specify what I have done wrong here?

[Kenneth Hobs]

That is odd. Try replacing the number or visible rows line of code to:
'Number of visible rows
n = NewMemoWks.Range("P17:P" & m).SpecialCells(xlCellTypeVisible).Cells.Count

[adamsm]

Thanks for the help. And I guess it works now. But I wonder why you've said "That is odd". I would be happy if you specify that?

[Kenneth Hobs]

If I knew what was odd about your workbook, I would have said so. In my workbook based on your first one, the code worked as I explained and without the need for cell counts. Sometimes, specialcells do not always behave the same way. Sometimes, you have to save prior to using them to get reliable results.

Anyway, using this code, in my workbook always returns the number of visible rows. Your workbook always shows 1. ergo, odd.
Sub SaveData2()
Dim r As Long
Dim m As Long
Dim n As Long

Dim NewMemoWks As Worksheet
Dim OrderWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

'cells to copy from Memos sheet - some contain formulas
myCopy = "E8,O6"

Set NewMemoWks = Worksheets("Memos")
Set OrderWks = Worksheets("OrderData")

With NewMemoWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the fields!", vbExclamation, "Save Order"
Exit Sub
End If
End With

' Use column N
m = NewMemoWks.Range("N" & NewMemoWks.Rows.Count).End(xlUp).Row
' Headers are now in row 4
If m = 16 Then
MsgBox "No data", vbExclamation
Exit Sub
End If

r = OrderWks.Range("E" & OrderWks.Rows.Count).End(xlUp).Row + 1

'Number of visible rows
n = NewMemoWks.Range("P17:P" & m).SpecialCells(xlCellTypeVisible).Rows.Count
Debug.Print n

End Sub

[adamsm]

Thanks for the reply. But in your previous version of the code you did not have the line? was this the reason for the code not to work as suggested?
Debug.Print n

[Kenneth Hobs]

No, debug.print just shows information. I wanted to verify that the number of visible rows was being counted. In my file, it was but not in yours. Changing rows to cells then displayed the correct count in both files. That is why I found it odd.