I'm dealing with an error and I don't really know what to do with it.
Private Sub commandbutton1_click()
Dim ws As Worksheet: Set ws = Sheets("inbd")
Dim wsDestination As Worksheet: Set wsDestination = Sheets("sheet1")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A1:N" & LastRow).AutoFilter Field:=1, Criteria1:=Worksheets("sheet1").Cells(1, 5).Value
This line of code below is giving me an error.
Sheets("INBD").Range("D2", Cells(Rows.Count, "D").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(2, 4).Copy _
Destination:=Sheets(1).Range("J1:K2")
It's supposed to copy the first visible cell in column D. (Credit: This part of the code was given to me by user "Marcucciboy2") I can't figure out how to integrate it with the rest of the code though.
Application.Run ("Macro8")
Application.Run ("Macro4")
Application.Run ("Macro5")
Application.Run ("Macro6")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A1:N" & LastRow).AutoFilter Field:=1, Criteria1:=Worksheets("sheet1").Cells(1, 5).Value
ws.Range("A1:N" & LastRow).AutoFilter Field:=1
End Sub
Sheets("INBD").Range("D2", Cells(Rows.Count, "D").End(xlUp)).SpecialCells(xlCellTypeVisible)
returns a block of cells one column wide - so it can't have a cells(2,4) as that defines something in the fourth column. You want cells(1,1) - the first cell within the visible cells.
Cells defines a cell with reference to a specified range unless you use Worksheets(X).cells in which case it's by reference to the whole spreadsheet: so Sheets("INBD").Cells(2,4) is cell D2, but Range("A100:D200").cells(2,4) is cell D200
Related
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("inbd")
Dim wsDestination As Worksheet: Set wsDestination = Sheets("test")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A1:N" & LastRow).AutoFilter Field:=1,
Criteria1:=Worksheets("test").Cells(1, 26).Value
ws.Range("f2:f" & LastRow).SpecialCells(xlCellTypeVisible).Copy Range("C6")
DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, "C").End(xlUp).Row + 1
wsDestination.Range("C" & DestinationRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ws.Range("A1:N" & LastRow).AutoFilter Field:=1
End Sub
Good evening, Paste values part is giving me an object defined error and I don't know why
You want a test to ensure there are visible cells to copy from:
If Application.WorksheetFunction.Countif(ws.Range("A1:N" & LastRow),Worksheets("test").Cells(1, 26).Value) > 0
. A test that you have more than one cell for your filter
If LastRow > 1
and you also have already pasted with this line:
ws.Range("F2:F" & LastRow).SpecialCells(xlCellTypeVisible).Copy Range("C6")
You pasted to C6 and now have an empty clipboard so cannot paste again.
Perhaps you wanted:
ws.Range("F2:F" & LastRow).SpecialCells(xlCellTypeVisible).Copy
DestinationRow = wsDestination.Cells(wsDestination.Rows.Count, "C").End(xlUp).Row + 1
wsDestination.Range("C" & DestinationRow).PasteSpecial xlPasteValues
You have already pasted the copied cells into the inbd sheet C6.
Your code does not make much sense. You determine the last row of data before you filter, you copy and paste, then you paste again. I suggest you first filter, then determine the last row in both sheets, then do the copy and paste special right after one another without the wrong paste to C6 step.
I'm running into an issue where I'm unable to copy only visible cells to a new sheet. I'm able to get the lastrow, but I get #N/A on every cell except the first for each column. I want to just copy the visible cells. I'd also like to only put information on visible rows too, if possible?
Please see my code below:
Sub Importe()
lastRow = Worksheets("Sheet1").Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row
Worksheets.Add
With ActiveSheet
Range("A1:A" & lastRow).Value2 = _
ActiveWorkbook.Worksheets("Sheet1").Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Value
Range("B1:B" & lastRow).Value2 = _
ActiveWorkbook.Worksheets("Sheet1").Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Value
End With
End Sub
Something like .Value2 = .Value doesn't work on special cells of type visible, because …
… e.g. if lastRow = 50 and there are hiddenRows = 10 then …
your source Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible)
has lastRow - hiddenRows = 40 rows
but your destination Range("A1:A" & lastRow).Value2
has lastRow = 50 rows.
On the first you subtract the visible rows, so they are different in size. Therefore .Value2 = .Value doesn't work, because you cannot fill 50 rows with only 40 source rows.
But what you can do is Copy and SpecialPaste
Option Explicit
Sub Importe()
Dim lastRow As Long
lastRow = Worksheets("Sheet1").Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row
Worksheets.Add
With ActiveSheet
ActiveWorkbook.Worksheets("Sheet1").Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy
.Range("A1").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("Sheet1").Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Copy
.Range("B1").PasteSpecial xlPasteValues
End With
End Sub
Nevertheless I recommend to avoid ActiveSheet or ActiveWorkbook if this is possible and reference a workbook eg by ThisWorkbook. My suggestion:
Option Explicit
Sub Importe()
Dim SourceWs As Worksheet
Set SourceWs = ThisWorkbook.Worksheets("Sheet1")
Dim DestinationWs As Worksheet
Set DestinationWs = ThisWorkbook.Worksheets.Add
Dim lastRow As Long
lastRow = SourceWs.Cells(1, 1).SpecialCells(xlCellTypeVisible).End(xlDown).Row
SourceWs.Range("H1:H" & lastRow).SpecialCells(xlCellTypeVisible).Copy
DestinationWs.Range("A1").PasteSpecial xlPasteValues
SourceWs.Range("E1:E" & lastRow).SpecialCells(xlCellTypeVisible).Copy
DestinationWs.Range("B1").PasteSpecial xlPasteValues
End Sub
To define whether a cell is visible or not, both its column and row should be visible. This means, that the .Hidden property of the column and the row should be set to False.
Here is some sample code of how to copy only the visible ranges between two worksheets.
Imagine that you have an input like this in Worksheets(1):
Then you manually hide column B and you want to get in Worksheets(2) every cell from the Range(A1:C4), without the ones in column B. Like this:
To do this, you should check each cell in the range, whether its column or row is visible or not.
A possible solution is this one:
Sub TestMe()
Dim myCell As Range
For Each myCell In Worksheets(1).Range("A1:C4")
If (Not Rows(myCell.Row).Hidden) And (Not Columns(myCell.Column).Hidden) Then
Dim newCell As Range
Set newCell = Worksheets(2).Cells(myCell.Row, myCell.Column)
newCell.Value2 = myCell.Value2
End If
Next myCell
End Sub
Just a general advise - whenever you use something like this Range("A1").Value2 = Range("A1").Value2 make sure that both are the same and not the left is Value2 and the right is .Value. It probably will not bring what you are expecting.
You cannot perform a direct value transfer without cycling though the areas of the SpecialCells(xlCellTypeVisible) collection.
Sometimes it is easier to copy everything and get rid of what you don't want.
Sub Importe()
Dim lr As Long
Worksheets("Sheet1").Copy after:=Worksheets("Sheet1")
With ActiveSheet
.Name = "xyz"
.Cells(1, 1).CurrentRegion = .Cells(1, 1).CurrentRegion.Value2
For lr = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1
If .Cells(lr, "A").EntireRow.Hidden Then
.Cells(lr, "A").EntireRow.Delete
End If
Next lr
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(1, 1).CurrentRegion.Resize(lr, 1) = .Cells(1, 1).CurrentRegion.Resize(lr, 1).Offset(0, 7).Value2
.Cells(1, 1).CurrentRegion.Offset(0, 1).Resize(lr, 1) = .Cells(1, 1).CurrentRegion.Resize(lr, 1).Offset(0, 4).Value2
.Columns("C:XFD").EntireColumn.Delete
End With
End Sub
just to throw in an alternative version:
Sub Importe()
Dim sht1Rng As Range, sht1VisibleRng As Range
With Worksheets("Sheet1")
Set sht1Rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set sht1VisibleRng = sht1Rng.SpecialCells(xlCellTypeVisible)
With Worksheets.Add
.Range("A1").Resize(sht1Rng.Rows.Count).Value2 = sht1Rng.Offset(, 7).Value2
.Range("B1").Resize(sht1Rng.Rows.Count).Value2 = sht1Rng.Offset(, 4).Value2
.UsedRange.EntireRow.Hidden = True
.Range(sht1VisibleRng.Address(False, False)).EntireRow.Hidden = False
End With
End Sub
which may have the drawback of Address() maximum "capacity "
I am trying to do something I imagine is really simple however I am stuck on part of the code.
I need the code to look at last row with a number in in column A and fill the series down once i.e.
A20 = 0019
A21 = 0020
Dim LastRow As Variant
Dim LastBlankRow As Variant
LastRow = Range("A" & Rows.Count).End(xlUp).Offset(0).Select
LastRow2 = Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.AutoFill Destination:=Range(LastRow & LastBlankRow), Type:=xlFillDefault
I started off with this code and developed it to the one above however my range will change each time as more data is entered.
Range("A20").Select
Selection.AutoFill Destination:=Range("A20:A21"), Type:=xlFillDefault
Range("A20:A21").Select
I imagine its something simple I have missed however I cant figure it out.
Thanks!
Don't rely on ActiveSheet, always qualify your Range, Rows objects with your Worksheet.
Code
Option Explicit
Sub FillOneDown()
Dim LastRow As Variant
With Worksheets("Sheet1") ' modify "Sheet1" to your sheet's name
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A" & LastRow).AutoFill Destination:=.Range(.Cells(LastRow, "A"), .Cells(LastRow + 1, "A")), Type:=xlFillDefault
End With
End Sub
To sum up, I try to copy some filtered data from a workbook A to a workbook B keeping the formatting of the workbook B.
Here is the relevant part of my code:
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
.SpecialCells(xlCellTypeVisible).Copy
End With
End With
destinationSheet.Range("B4").PasteSpecial xlPasteValues
The paste special is not working and this is the formatting of the workbook A that is used.
Solved:
The problem was that you can't use PasteSpecial in a discontinuous range.
So I went with the solution of Siddharth Rout to go through all the areas of the filtered range:
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
'~~> Loop through each area
For Each area In filteredRange.Areas
With destinationSheet
'~~> Find Next available row
lRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
area.Copy
destinationSheet.Range("B" & lRow).PasteSpecial xlPasteValues
End With
Next area
End With
End With
What #Jeeped has mentioned is very true that you cannot used Paste Special on a filtered range if they are Non Contiguous. However there is a way to achieve what you want :)
You have to loop through each area of the filtered range and then use Paste Special as shown below
Sub Sample()
Dim ws As Worksheet
Dim lastRowOriginSheet As Long
Dim filteredRange As Range, a As Range
Dim projectNumber As Long
'~~> I have set these for testing. Change as applicable
projectNumber = 1
Set ws = Sheet1
Set destinationSheet = Sheet2
lastRowOriginSheet = 16
With ws
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set filteredRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
'~~> Loop through each area
For Each a In filteredRange.Areas
With destinationSheet
'~~> Find Next available row
lRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
a.Copy
destinationSheet.Range("B" & lRow).PasteSpecial xlPasteValues
End With
Next a
End With
End With
End Sub
In Action
PasteSpecial does not work on a discontiguous range. If you have one hidden row in among visible rows then you have a discontiguous range. However, due to the nature of a discontiguous range, a straight copy and paste will paste formats and the values from formulas; i.e. it cannot determine how to shift the cell ranges in formulas so it just pastes values.
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
'you should probably check to ensure you have visible cells before trying to copy them
.SpecialCells(xlCellTypeVisible).Copy destination:=destinationSheet.Range("B4")
End With
End With
Try this. Instead of doing PasteSpecial, since you just need values, you can set the ranges equal to eachother.
Dim copyRng As Range
With originSheet
.AutoFilterMode = False
With .Range("A7:AA" & lastRowOriginSheet)
.AutoFilter Field:=2, Criteria1:=projectNumber
Set copyRng = .SpecialCells(xlCellTypeVisible)
End With
End With
' destinationSheet.Range("B4").Value = copyRng.Value
With destinationSheet
.Range(.Cells(4, 2), .Cells(4 + copyRng.Rows.Count - 1, 2 + copyRng.Columns.Count - 1)).Value = copyRng.Value
End With
(this is assuming your worksheet and lastRow and projectNumber are all declared properly and working).
Edited because if you just do Range("B4").Value = Range("A1:Z100").Value, it's only going to put the first value in your copied range in the cell. You need to expand the destination range to be the size of the copy range.
I have an AutoFilter that once it is applied it always outputs one row. I want to copy this one row and paste it on another Sheet.
I have considered:
xlCellTypeAllValidation but it throws out an error
xlCellTypeSameValidation there are many validation criteria an AutoFilter
xlCellTypeLastCell but it gives the location of the last cell in the filtered row
How can i do this?
Here is an excerpt from my code:
With ThisWorkbook.Sheets(k).Range("A1:AZ1")
.Value = .Value
.AutoFilter field:=1, Criteria1:=Rev_1
.AutoFilter field:=11, Criteria1:=Beginnings(k)
.AutoFilter field:=12, Criteria1:=End_Instnts(k)
For zz = 13 To last_Field
.AutoFilter field:=zz, Criteria1:=""
Next zz
.SpecialCells(xlCellTypeLastCell).Select
.Range.Select
ThisWorkbook.Sheets(k).AutoFilterMode = False
End With
I'd recommend testing to ensure something actually matched the criteria before you copy - something like:
With ThisWorkbook.Sheets(k).Range("A1").CurrentRegion.Resize(, 52)
.Value = .Value
.AutoFilter field:=1, Criteria1:=Rev_1
.AutoFilter field:=11, Criteria1:=Beginnings(k)
.AutoFilter field:=12, Criteria1:=End_Instnts(k)
For zz = 13 To last_Field
.AutoFilter field:=zz, Criteria1:=""
Next zz
' make sure there are results matching filter
If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
' offset and resize to avoid headers then copy
.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("other sheet").Range("A1")
End If
ThisWorkbook.Sheets(k).AutoFilterMode = False
End With
You can select all filtered region and then copy it, it will copy visible rows only anyway. Or combine it with .SpeciallCells(xlCellTypeVisible)
Smthng like (after End With) (assuming data starts from Row 2)
Range("A2:AZ1").Copy Destination:=PasteRange
One approach is to use Special Cells targeting visible cells only. One really quick and painless variant is to just use offset.
See the following:
Sub CopyFilterResult()
Dim WS1 As Worksheet, WS2 As Worksheet
With ThisWorkbook
Set WS1 = .Sheets("Sheet1")
Set WS2 = .Sheets("Sheet2")
End With
'Apply your filters here.
WS1.UsedRange.Offset(1, 0).Copy WS2.Range("A1")
End Sub
Screenshots:
Source (with filter):
Result:
Something to keep as a an alternative.
Let us know if this helps.
EDIT:
This code is as per exchange in comments. Read the comments and modify it to suit your needs.
Sub CopyAfterFilterMk2()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim RngBeforeFilter As Range, RngAfterFilter As Range
Dim LCol As Long, LRow As Long
With ThisWorkbook
Set WS1 = .Sheets("Sheet1")
Set WS2 = .Sheets("Sheet2")
End With
With WS1
'Make sure no other filters are active.
.AutoFilterMode = False
'Get the correct boundaries.
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
LCol = .Range("A1").End(xlToRight).Column
'Set the range to filter.
Set RngBeforeFilter = .Range(.Cells(1, 1), .Cells(LRow, LCol))
RngBeforeFilter.Rows(1).AutoFilter Field:=1, Criteria1:="o"
'Set the new range, but use visible cells only.
Set RngAfterFilter = .Range(.Cells(2, 1), .Cells(LRow, LCol)).SpecialCells(xlCellTypeVisible)
'Copy the visible cells from the new range.
RngAfterFilter.Copy WS2.Range("A1")
'Turn off the filter.
.AutoFilterMode = False
End With
End Sub
This code handles multiple rows post-filter as well.
Let us know if this helps.