vba code to copy all cells in a variable range

[andycreber]

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

 

[offthelip]

try this: I am using variant arrays to do the copy which is much more flexible and faster than using the copy paste method.

Sub test2()
Dim outarr() As Variant


Sheets("FL").Select
lastrow = Cells(Rows.Count, "I").End(xlUp).Row
inarr = Range(Cells(4, 9), Cells(lastrow, 9))
ReDim outarr(1 To lastrow, 1 To 1)
indi = 1
For i = 1 To lastrow - 3
If inarr(i, 1) <> "" Then
 outarr(indi, 1) = inarr(i, 1)
 indi = indi + 1
End If
Next i


Sheets("Dump").Select
lastdump = Cells(Rows.Count, "B").End(xlUp).Row + 1
Range(Cells(lastdump, 2), Cells(lastdump + indi, 2)) = outarr




End Sub

 

[andycreber]

Thanks. Do I put this instead of the bolded line?

 

[offthelip]

No it replaces all of your code

 

[Fluff]

Another option
Dim Lr As Long

With Sheets("FL")
Lr = .Range("I:I").find("*", , xlValues, , xlbyrow, xlPrevious, , , False).Row
.Range("I4:I" & Lr).Copy
Sheets("Dump").Range("B5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With

 

[andycreber]

Another option
Dim Lr As Long

With Sheets("FL")
Lr = .Range("I:I").find("*", , xlValues, , xlbyrow, xlPrevious, , , False).Row
.Range("I4:I" & Lr).Copy
Sheets("Dump").Range("B5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With

Hi Fluff,
Thanks for the reply.

I have a slight problem my remaining code if you could help me with it. The full code is below. 2 issues, the first is on the code not pasting the data in to correct row the dump sheet, it is ignoring the last row that contains data for the xl up and pasting the data over the top.

the second issue is that for Sheet FL the data is not pasting in the right rows for columns B & C. The xl up appears not to be looking for the last cell containing data, it is putting the data 29 rows the last cell containing data.

The strange thing is that this is working for columns F & G and I cannot see a difference why.


I have about 20 more sheets I have to do this code for which i can copy the code and change the name of the sheets.

Your valuable help will be very much appreciated.

thanks

Sub Macro2 Macro
'


'AS SHEET




Dim Lr As Long


With Sheets("AS")
Lr = .Range("I:I").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("I4:I" & Lr).Copy
Sheets("Dump").Range("B5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With

With Sheets("AS")
Lr = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("J4:J" & Lr).Copy
Sheets("Dump").Range("C5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With



With Sheets("AS")
Lr = .Range("M:M").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("M4:M" & Lr).Copy
Sheets("Dump").Range("F5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With




With Sheets("AS")
Lr = .Range("N:N").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("N4:N" & Lr).Copy
Sheets("Dump").Range("G5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With







'FL SHEET






With Sheets("FL")
Lr = .Range("I:I").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("I4:I" & Lr).Copy
Sheets("Dump").Range("B5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With

With Sheets("FL")
Lr = .Range("J:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("J4:J" & Lr).Copy
Sheets("Dump").Range("C5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With



With Sheets("FL")
Lr = .Range("M:M").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("M4:M" & Lr).Copy
Sheets("Dump").Range("F5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With


With Sheets("FL")
Lr = .Range("N:N").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
.Range("N4:N" & Lr).Copy
Sheets("Dump").Range("G5000").End(xlUp).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With




End Sub

 

[andycreber]

I have found that in the rows that it is skipping the code is putting in a blank space, if that helps!

 

[MARK858]

Can you see what the code below does for you? It assumes you want the next blank cell and not overwrite the last cell, if this is not correct then remove the (2).

Sub CopyVals()
    Dim Lr As Long

    With Sheets("FL")
        Lr = .Range("I:J").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row
        .Range("I4:J" & Lr).Copy
        Sheets("Dump").Range("B" & Sheets("Dump").Range("B:C").Find("*", , xlValues, , xlByRows, xlPrevious, , , False).Row)(2).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub

 

[andycreber]

Hi thanks for the code, unfortunately this did not work with or without the (2)

The issue is with the copy paste special values on the blank cells it puts in a space when the past special values happen and only for columns B & C

any help will be greatly appreciated.

thanks

 

[MARK858]

In a blank cell put the formula =ISBLANK(Z9) changing the Z9 to the cell reference where the "space when the past special values happen"
What does it return?