Solved: copy cells to column without blanks

[thmh]

hy,
how to copy cells from table in column C to column B without blanks , and do this for 250 tables in sheet

[p45cal]

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]

i cant do this manually there is to match data , so here is workbook with first 4 tables , i use excel 2007

[p45cal]

see what this does for you:
[vba]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
[/vba]

[thmh]

tnx, great code for my first macro ,

i used offset to get correct range for second macro ,

[vba]

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


[/vba]

[p45cal]

Yuk with the Goto!

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

[thmh]

yes, it's better , tnx