Macro help: Stop copying formatted blank cells

[bubblyboo]

Hello,

I hope you can help & it may be a really easy answer, but I've looked on forums & I can't seem to find the answer to my question.

I currently have the following macro (it's not very tidy but it works fine):

Sub JobSheet()
' JobSheet Macro
'
Sheets("Enquiries").Select
Range("A10").Select

With ActiveSheet
Set Rng = .UsedRange
With Rng

.AutoFilter Field:=7, Criteria1:=Array( _
"Awaiting Response", "Being Repaired", "Logged"), Operator:=xlFilterValues
.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible).Copy
Sheets("Job Sheet").Select
Range("A9").Select
ActiveSheet.Paste
Sheets("Enquiries").Select
.AutoFilter Field:=7
Sheets("Job Sheet").Select
Range("A9").Select
Rows("6:14").Select
Selection.Delete Shift:=xlUp
Range("D7").Select
Columns("A:H").EntireColumn.AutoFit

End With
End With

End Sub


As I say it's working fine & copying all the data across, but it's also copying the blank cells underneath the filtered results. I think it's possibly because the blank cells underneath are formatted ie they have a black border. Is it possible to copy only the cells containing data?
I have tried using 'LastCell' & End(xlup) but I'm quite new to macros & VBA and have failed.
If someone could help me, I'd be really grateful & you would be saving me a lot of time!
Thank you

 

[asking]

Try these adjustments ~ Save your workbook before running any new macro's

This line ~ Assumes your header row is in row 5 and the number of columns used is 8

Range("OFFSET($A$5,1,0,COUNT(OFFSET($G$5,1,0,9999)),8)").Select

Where the two $5 are, change to your header row number and change the 8 at the end to the numbers of columns in your data.

So if your header row is in row 10 and your number of columns is 16 it would be ~
Range("OFFSET($A$10,1,0,COUNT(OFFSET($G$10,1,0,9999)),16)").Select

If you wish to also transfer the header row $A$10 would become $A$9 and $G$10 would become $G$9

Sub JobSheet()
' JobSheet Macro
'
Sheets("Enquiries").Select
Range("A10").Select

With ActiveSheet
Set Rng = .UsedRange
With Rng

.AutoFilter Field:=7, Criteria1:=Array( _
"Awaiting Response", "Being Repaired", "Logged"), Operator:=xlFilterValues
Range("OFFSET($A$5,1,0,COUNT(OFFSET($G$5,1,0,9999)),8)").Select
Selection.SpecialCells(xlCellTypeVisible).Copy
Sheets("Job Sheet").Select
Range("A9").Select
ActiveSheet.Paste
Sheets("Enquiries").Select
.AutoFilter Field:=7
Sheets("Job Sheet").Select
Columns("A:H").EntireColumn.AutoFit

End With
End With

End Sub

Cheers.

 

[bubblyboo]

Thank you so much for your help... but it's coming back with an error:

Method 'Range' of object'_Global' failed

When I click on 'Debug' it highlights this row

Range("OFFSET($A$10,1,0,COUNT(OFFSET($G$10,1,0,9999)),12)").Select

Thank you!

 

[asking]

Hi bubblyboo.

I have tested it in excel 2007 and it works fine for me, perhaps you could give me a little more information and I will make some changes.

What row is your header in?
How many columns of data do you have?
Do you wish to have the header in the transfer?

With that info I can set the range in the name manager so that it does not use the formula in the macro.

Ta.

 

[bubblyboo]

Well, my headers are in rows 9-12. I have data in columns A:L (although I do have hidden data in columns P:T)

I don't really need the headers copying across, because I have already added them into worksheet 2 ("Job Sheet"). So I can just paste the data straight in.

I have been playing and have come up with this macro. It's extremely long & I apologise if it's very messy & confusing! It does work & stops copying the blank cells, but I've had to do it by copying the visible cells only, then pasting them without borders, then resetting the lastcell & adding borders (!) as follows:

Sub JobSheet()
' JobSheet Macro
Sheets("Enquiries").Select
Range("A10").Select

With ActiveSheet
Set Rng = .UsedRange
With Rng

.AutoFilter Field:=7, Criteria1:=Array( _
"Awaiting Response", "Being Repaired", "Logged"), Operator:=xlFilterValues
Sheets("Enquiries").Select
Range("A12").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Job Sheet").Select
Range("A9").Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=False
Dim x As Integer
x = ActiveSheet.UsedRange.Rows.Count
Range("A9").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select
Sheets("Enquiries").Select
.AutoFilter Field:=7
Sheets("Job Sheet").Select
Range("H7,K7").Select
Range("K7").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("I4").Select
Columns("H:H").ColumnWidth = 10.43
Columns("K:K").ColumnWidth = 9.86
Columns("G:G").EntireColumn.AutoFit
Columns("L:L").ColumnWidth = 73.14
Range("A7").Select
x = ActiveSheet.UsedRange.Rows.Count
End With
End With

End Sub


You may be able to think of a much easier & tidier macro! As I say I'm quite novice (blush!)
Thank you so much

 

[asking]

Ok, try this make sure you save your workbook first!

Have fully tested with Excel 2007

Go to the name manager in the formulas menu, click new, in the box next to name type Joblot, in the refers to box paste this formula and click OK

=OFFSET(Enquiries!$A$12,1,0,COUNTA(OFFSET(Enquiries!$G$12,1,0,9999)),20)

Then this new macro, delete the previous version.

Sub JobSheet()
Sheets("Enquiries").Select
With ActiveSheet
Set rng = Range("A12:T12")
With rng
.AutoFilter Field:=7, Criteria1:=Array( _
"Awaiting Response", "Being Repaired", "Logged"), Operator:=xlFilterValues
Range("Joblot").Select
Selection.SpecialCells(xlCellTypeVisible).Copy
Sheets("Job Sheet").Select
Range("A9").Select
ActiveSheet.Paste
Columns("A:H").EntireColumn.AutoFit
Sheets("Enquiries").Select
Selection.AutoFilter
End With
End With
End Sub

Go to the Job Sheet and see if it did what you required.
Hope that works for you! Cheers.

 

[bubblyboo]

Wow! That is amazing! - I really am a novice
Thank you so much, really appreciated