VBA - paste only non empty cells from multiple sheets in the next empty row on a different/master sheet

[smide]

Hello.


In Sheet1,2,3,4 and Sheet5 of my Workbook I have a data stored in column C (on all sheets). I need to copy only non empty cells from all sheet's (column C) into column D of my master sheet (Sheet6) in the next empty row eg. without empty cells.
All those five sheets (as well as master sheet) have a header in row 1, and I don't want to copy text from that header.


The problem is also in the fact that my data on those five sheets could start from any row. Search area in column C: from C2 to C700 per sheet.
Empty cells in column C of those sheets could contain formula like: =if(A2="","",B2).


This is what I want to do.


example.

Sheet1

	A	B	C
1			Header1
2
3			2
4			4
5			7
6

<tbody>
</tbody>

Sheet2

	A	B	C
1			Header2
2
3
4
5			8
6			0
7			6
8
9

<tbody>
</tbody>

​

Sheet3

	A	B	C
1			Header3
2
3
4			18
5			19
6

<tbody>
</tbody>

​

Sheet4

	A	B	C
1			Header4
2
3
4
5
6
7
8
9
10
11			34
12			45
13
14

<tbody>
</tbody>

Sheet5

	A	B	C
1			Header5
2
3
4
5			96
6			105

<tbody>
</tbody>

Sheet6 (master sheet - after Macro run)

	A	B	C	D
1				Header
2				2
3				4
4				7
5				8
6				0
7				6
8				18
9				19
10				34
11				45
12				96
13				105
14				...
15				...

<tbody>
</tbody>

 

[Akuini]

Hello.


In Sheet1,2,3,4 and Sheet5 of my Workbook I have a data stored in column C (on all sheets). I need to copy only non empty cells from all sheet's (column C) into column D of my master sheet (Sheet6) in the next empty row eg. without empty cells.
All those five sheets (as well as master sheet) have a header in row 1, and I don't want to copy text from that header.


The problem is also in the fact that my data on those five sheets could start from any row. Search area in column C: from C2 to C700 per sheet.
Empty cells in column C of those sheets could contain formula like: =if(A2="","",B2).

Try this:

Sub a1013344a()

Dim ws As Worksheet, ws6 As Worksheet
Dim ra As Long, rb As Long
    Application.ScreenUpdating = False
Set ws6 = Sheets("Sheet6")
For Each ws In Worksheets
    If UCase(ws.name) <> UCase("Sheet6") Then
        With ws
        ra = .Range("C" & Rows.count).End(xlUp).row
        rb = ws6.Range("D" & Rows.count).End(xlUp).row
        ws6.Range(ws6.Cells(rb + 1, "D"), ws6.Cells(rb + ra - 1, "D")).Value = _
        ws.Range(ws.Cells(2, "C"), ws.Cells(ra, "C")).Value
        End With
    End If
Next
On Error Resume Next
With ws6.Range("D2", ws6.Cells(Rows.count, "D").End(xlUp))
.SpecialCells(xlCellTypeBlanks).Rows.Delete
.SpecialCells(xlConstants, xlErrors).Rows.Delete
End With
    Application.ScreenUpdating = True
End Sub

 

[smide]

Works great!
Thank you.

 

[Akuini]

Works great!
Thank you.

You're welcome & thanks for replying