Ignore blank cells

[hezcal11]

Hello,
I currently have a programme excel 2010 that allows people to enter their shift availability for the month which is then transferred to a master sheet on another sharepoint area. I am trying to automate it so that it can be changed each month without too much hassle. The problem I have is that the first of each month is usually a different day so when I transfer the information it can move out of synch with the master table. I have a table to explain. On this particular month the first is a wednesday, so when I transfer this information over I need the box with the x in it to be the first box on the new table, that is ignore the two yellow cells. This can only be for the first cells as there will be blank cells in the availability, the 3rd for example, but I need these gaps to remain.
I hope someone can help. I have probably made it sound more complicated than it is.

Thanks


Colin

M	T	W	T	F	S	S
		1st	2nd	3rd	4th	5th
		X	E		B	E

<TBODY>
</TBODY>

W	T	F	S	S
1st	2nd	3rd	4th	5th
X	E	E	B

<COLGROUP><COL style="WIDTH: 48pt" span=5 width=64><TBODY>
</TBODY>

 

[MARK858]

Possibly something like below (please note I have assumed that you already have the top row in sheet 2 filled out and that you made a typo in your post and the order in the second table should be XEBE not XEEB).
Change the sheetnames to suit.

Sub XXX()
    Dim LstRw As Long, i As Long
    LstRw = Sheets("Sheet1").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
    For i = 2 To LstRw
        Sheets("Sheet1").Rows(i).SpecialCells(xlCellTypeConstants, 23).Copy Sheets("Sheet2").Range("A" & Sheets("Sheet2").Rows.Count).End(xlUp).Offset(1)
    Next
End Sub

 

[hezcal11]

Possibly something like below (please note I have assumed that you already have the top row in sheet 2 filled out and that you made a typo in your post and the order in the second table should be XEBE not XEEB).
Change the sheetnames to suit.

Sub XXX()
    Dim LstRw As Long, i As Long
    LstRw = Sheets("Sheet1").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
    For i = 2 To LstRw
        Sheets("Sheet1").Rows(i).SpecialCells(xlCellTypeConstants, 23).Copy Sheets("Sheet2").Range("A" & Sheets("Sheet2").Rows.Count).End(xlUp).Offset(1)
    Next
End Sub

Thanks will give it a try. I'm amazed you could understand my ramblings!!!

 

[MARK858]

Actually after reading it again I don't think the macro will work for you as I think you meant your second table to look like...

Excel Workbook
	A	B	C	D	E
1	W	T	F	S	S
2	1st	2nd	3rd	4th	5th
3	X	E		B	E
Sheet4

 

[MARK858]

If my reading of the post is now correct try the code below on a copy of your workbook.

Sub XXX()
    Dim LstRw As Long, i As Long, lstCo As Long, x As Long, LstRW2 As Long
    Application.ScreenUpdating = 0

    With Sheets("Sheet1")

        LstRw = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
        lstCo = .Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column

        x = .Rows(2).Find(What:="1st", After:=.Cells(2, lstCo), LookIn:=xlValues, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column

        LstRW2 = Sheets("Sheet2").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

        For i = 3 To LstRw

            .Range(.Cells(i, x), .Cells(i, lstCo)).Copy Sheets("Sheet2").Cells(LstRW2, 1)
            LstRW2 = LstRW2 + 1
        Next
    
    End With

    Application.ScreenUpdating = 1
End Sub

 

[MARK858]

I was too late to add this as an edit to my last post.

Obviously it is assuming you have the first 2 rows in Sheet2 already and please note that it searches for the text "1st" in Row 2 , Sheet1 so make sure that is your exact wording.

 

[hezcal11]

I will adjust and try again. I did make a `mistake in the second table. Thanks for taking the time to amend it.