vba code to copy all cells in a variable range

andycreber

Board Regular
Joined
May 20, 2010
Messages
74
Office Version
  1. 2016
Hi all

I have the following code in bold are copying cells that return data in formula after cell I4, but it is copying cells with a formula in it even if the formula is not returning any data, so visually the cells appear to be blank. IE my has to go down to 25 rows but in various cases the copied data may only apply to 5 rows.

It there a way to only copy the returned data in the formula? IE 5 rows without removing the formulas on the source sheet for the blank data

Reason being when I paste special values in the "Dump" sheet it is not finding the last true blank cell, its finding the whole copied range IE 20 rows so when this happens with multiple sheets there are blank rows in my data that cannot be sorted to align the rows.

All help would be greatly appreciated

thanks MR Excel helpers


Sheets("FL").Select
Range("I4").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Dump").Select
Range("B5000").End(xlUp).Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
Hi, unfortunately that did not work, however I have managed to get the cells in column 2 & 3 (B,C) to delete the blank cells with spaces, with the below code, but I have 2 other issues: On the "Dump" tab, columns A, B, C, F & G ignore the last row of data being my header and paste it over the top and same happens with sheet "FL" data, that it pastes over the top over the top of the last row.


So it appears the .End(xlUp) does not work for sheets "AS" and "FL", it is ignoring the last cell with data in it, any idea how to fix this?


Any help appreciated






Code:
[COLOR=#141414][FONT=Verdana]Sub Macro2()[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]'AS SHEET[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]Dim Lr As Long[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]  With Sheets("AS")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("H:H").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("H4:H" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("A5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]With Sheets("AS")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("I:I").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("I4:I" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("B5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]  With Sheets("AS")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("J4:J" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("C5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]  With Sheets("AS")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("M:M").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("M4:M" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("F5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]  With Sheets("AS")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("N:N").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("N4:N" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("G5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]




[COLOR=#141414][FONT=Verdana]'FL SHEET[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]  With Sheets("FL")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("H:H").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("H4:H" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("A5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]With Sheets("FL")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("I:I").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("I4:I" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("B5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]  With Sheets("FL")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("J4:J" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("C5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]

[COLOR=#141414][FONT=Verdana]  With Sheets("FL")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("M:M").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("M4:M" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("F5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]  With Sheets("FL")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Lr = .Range("N:N").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana].Range("N4:N" & Lr).Copy[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Range("G5000").End(xlUp).PasteSpecial xlPasteValues[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.CutCopyMode = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim lRow As Integer[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim intCol As Long[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Dim rngCell As Range, fn[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Set fn = Application.WorksheetFunction[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.ScreenUpdating = False[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]For intCol = 2 To 3[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    For lRow = 353 To 2 Step -1[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        Set rngCell = Cells(lRow, intCol)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        With rngCell[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            .Value = fn.Substitute(rngCell.Value, Chr(160), Chr(32))[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            .Value = Trim(rngCell.Value)[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        End With[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        If Len(rngCell) = 0 Then[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]            rngCell.Delete shift:=xlUp[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        End If[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]        Set rngCell = Nothing[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Next lRow[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Next intCol[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Application.ScreenUpdating = True[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]
[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Sheets("Dump").Select[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]Range("I11").Select[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Selection.AutoFill Destination:=Range("I11:I206")[/FONT][/COLOR]


[COLOR=#141414][FONT=Verdana]    Range("D11").Select[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]    Selection.AutoFill Destination:=Range("D11:D206")[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]   Range("A1").Select[/FONT][/COLOR]
[COLOR=#141414][FONT=Verdana]End Sub[/FONT][/COLOR]
 
Last edited by a moderator:
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
It is not ignoring the last row, it is finding it. End(xlUp) finds the last cell with data not the empty cell after it so you need to offset it by 1.

Either
Code:
Sheets("Dump").Range("B5000").End(xlUp).Offset(1, 0)

or

Code:
Sheets("Dump").Range("B5000").End(xlUp).Offset(1)

or

Code:
Sheets("Dump").Range("B5000").End(xlUp)(2)

and it is the same using Find.

so for example

Code:
Lr = .Range("H:H").Find("*", , xlValues, , xlByRows, xlPrevious, , , False)(2).Row
or any of the other above methods or

Code:
Lr = .Range("H:H").Find("*", , xlValues, , xlByRows, xlPrevious, , , False)(2).Row + 1
 
Last edited:
Upvote 0
Mark858

This resolved the issue, thank you for all you time and work on this.

you're a legend

have a great day
 
Upvote 0

Forum statistics

Threads
1,223,912
Messages
6,175,340
Members
452,638
Latest member
Oluwabukunmi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top