Macro to copy row if target cell is not blank

Hi Guys,

I've a workbook that contains multiple worksheets with exactly the same structure. I want to combine all the worksheets into one by copying the entire row if cells in column "C" in not blank - need to start from row 10.

Another complication is that in each of the worksheets there are values in cells (C1, C2, C3) which i need to copy them in three different columns in front of all copied rows from each sheet.

Any help will be much appreciated.

Thanks.

Hi John,

This is a quick attempt in the absence of an example of the file.

It assumes you have a "Summary" sheet, and you are copying small amounts of data.

Please Login or Register  to view this content.

If the worksheets are large, and/or you find this a little slow, we could speed it up by reading into an array, however, from what I remember from the last time I helped you, your worksheets are not huge, so this quick bit of code should do the trick.

I hope this helps, please let me know!

Regards,

David


- Please click on the *Add Reputation button at the bottom of helpful responses.

Please mark your thread as SOLVED:
- Click Thread Tools above your first post, select "Mark your thread as Solved".

Thanks Pierre and David,

I've managed to get 90% of the code but i'm missing the part of filling in the first three columns in the summary sheet with the values in cells C1 & C2 & C3 in each sheet.

the below code is doing everything except that it fills the three columns but only for the first row for each range of data brought from each sheet.

i think the part needs to be updated is the part in Red below:

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
Dim FirstRow As Long
Dim rng1 As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"

' Fill in the start row.
StartRow = 10

' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then

' Find the last row with data on the summary
' and source worksheets.
Last = LastRow(DestSh)
shLast = LastRow(sh)

' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.



If shLast > 0 And shLast >= StartRow Then
'Set the range that you want to copy
Set CopyRng = sh.Range("C10:Q300")
Set CopyRng1 = sh.Range("C1:C3")

' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.count > DestSh.Rows.count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If

' This statement copies values and formats.
CopyRng.Copy
With DestSh.Cells(Last + 1, "D")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

CopyRng1.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
End With

End If

End If

On Error Resume Next
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

FirstRow = 1



Sheets("RDBMergeSheet").Range("A&FirstRow:A" & Range("D" & Rows.count).End(xlUp).Row) = ws.Cells(1, "C")
Sheets("RDBMergeSheet").Cells(Range(FirstRow, Cells(Rows.count, "D").End(xlUp).Row), 2) = ws.Cells(2, "C")
Sheets("RDBMergeSheet").Cells(Range(FirstRow, Cells(Rows.count, "D").End(xlUp).Row), 3) = ws.Cells(3, "C")

FirstRow = FirstRow + Cells(Rows.count, "D").End(xlUp).Row

Next

ExitTheSub:

Application.Goto DestSh.Cells(1)

' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit

With Application
.ScreenUpdating = True
.EnableEvents = True
End With


End Sub

Hi John,
I agree with Pierre! It i very difficult to read your macro as posted. Perhaps you could also include a sample workbook - it would be easier to understand what you are trying to do!

From what I could see of the macro(s) you posted it seems unnecessarily complex, but difficult to test without data.

Did you try my macro? It does what you described, but with far fewer lines of code. The main difference being it uses a "Summary" sheet rather than "RDBMergeSheet".

Regards,

David