PDA

View Full Version : Solved: copy cells to column without blanks



thmh
07-17-2011, 05:53 AM
hy,
how to copy cells from table in column C to column B without blanks , and do this for 250 tables in sheet
http://www.easilysharing.com/images/55345690820609933591.jpg

p45cal
07-17-2011, 09:31 AM
Manually, you'd do this on the first table by selecting cells C4:C27, pressing F5, Special…, choosing Constants (all 4 sub-options ticked perhaps) OK, then selecting the single cell under the last entry in the table in column B (that's B7 in this case) and Ctrl+V to paste.

Now to convert this to a macro we need to know exactly where the tables are - are they religiously evenly laid out in the whole sheet? do the tables go across as well as down? Can the rows to be processed be determined by say the positioning of the 1s and the word Team in column A?

thmh
07-18-2011, 07:53 AM
i cant do this manually there is to match data , so here is workbook with first 4 tables , i use excel 2007

p45cal
07-18-2011, 12:52 PM
see what this does for you:
Sub blah()
With Sheets("Player Stats").Columns(1)
Set c = .Find(1, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Select
Set SourceRange = Range(c, c.End(xlDown)).Offset(, 2)
SourceRange.Select
For Each cll In SourceRange.Cells
If cll.Value <> "" Then
' cll.Select
For Each celle In SourceRange.Offset(, -1).Cells
If celle.Value = "" Then
' 'cll.Copy celle
'cll.Cut celle
celle.Value = cll.Value
'celle.Select
Exit For
End If
Next celle
End If
Next cll
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

thmh
07-19-2011, 09:41 AM
tnx, great code for my first macro ,

i used offset to get correct range for second macro ,



Sub blah_mod()


With Sheets("Player Stats").Columns(1)
Set c = .Find(1, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address

Do

c.Select
Set SourceRange = Range(c.Offset(-1, 3), c.Offset(24, 3))
SourceRange.Copy

Set iC = c.Offset(-1, 3)

If iC = "" Then GoTo nextc

c.Offset(-1, iC.Value + 3).PasteSpecial Paste:=xlValues

nextc:

Set c = .FindNext(c)

Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

p45cal
07-19-2011, 10:27 AM
Yuk with the Goto!

Try:
If iC <> "" Then c.Offset(-1, iC.Value + 3).PasteSpecial Paste:=xlValues and lose the
nextc:

thmh
07-19-2011, 01:33 PM
yes, it's better , tnx