Copy cells from one worksheet to another while skipping blanks

Gawk,
Please wrap your code with tags.
A picture would not help to test a code. Please attach a sample book.

Sorry! Here you go.

Sub Copy_ShortName_to_PR_W1Monday()
    Dim cell As Range, r As Long
    r = 8
    Application.ScreenUpdating = False
    Sheets("K-5 (5 Week FV Bar) PR").Range("A8:A33").ClearContents
    For Each cell In Sheets("K-5 (5 Week FV Bar)").Range("CZ9:DD34, CZ363:CZ365")
        If Len(cell) > 0 Then
            Sheets("K-5 (5 Week FV Bar) PR").Range("A" & r).Value = cell.Value
            r = r + 1
        End If
    Next cell
    Application.ScreenUpdating = True
    End Sub

Try this code

Sub Copy_ShortName_to_PR_W1Monday()
    Dim cell As Range, r As Long
    r = 8
    Application.ScreenUpdating = False
    On Error Resume Next
    Sheets("K-5 (5 Week FV Bar) PR").Range("A8:A33").ClearContents
    For Each cell In Sheets("K-5 (5 Week FV Bar)").Range("CZ9:DD34, CZ363:CZ365")
        If Len(cell) > 0 Or Len(cell.Text) > 0 Then
            Sheets("K-5 (5 Week FV Bar) PR").Range("A" & r).Value = cell.Value
            r = r + 1
        End If
    Next cell
    Application.ScreenUpdating = True
    End Sub

The reason that you are getting errors because some of the formulas are returning an error. To avoid error, you can use Iferror like this

IFERROR(ConcRange(EA16:EE16,CHAR(10)),0)

Thank you for replying so quickly. Unfortunately, it still dumps everything into column A.

That was the code supposed to do.
This line

Sheets("K-5 (5 Week FV Bar) PR").Range("A" & r).Value = cell.Value

Dumped to column A

I'm sorry. I guess I didn't explain myself very well. I want it to go across columns instead of being dumped all down 1 column. If you take a look at the picture on my very first post, that's what I want it to do.

Gawk,
Few issues with this code. My understanding is you want to copy all non zero starting from A8 across. The problem is you U8. The code loops correctly and copies all values in the next empty column, but the last empty column is U8

Sub Copy_ShortName_to_PR_W1Monday()
    Dim cell As Range, r As Long
    r = 1
    Set ms = Sheets("K-5 (5 Week FV Bar) PR")
    Application.ScreenUpdating = False
    On Error Resume Next
    ms.Range("A8:U8").ClearContents
    For Each cell In Sheets("K-5 (5 Week FV Bar)").Range("CZ9:DD34, CZ363:CZ365")
        If Len(cell) > 0 Or Len(cell.Text) > 0 Then
            ms.Cells(8, r).Value = cell.Value
            r = r + 1
        End If
    Next cell
    Application.ScreenUpdating = True
    Set ms = Nothing
    End Sub

Gawk,
I have not looked at the post-just checked your code. I will come back with a solution shortley

Gawk,
I have not looked at the post-just checked your code. I will come back with a solution shortley

Gawk,
As an option, this code skipps any cell with an error. When I run this code, it only finds 6 cells with data, did not even go in to Column U.

Sub Copy_ShortName_to_PR_W1Monday()
    Dim cell As Range, r As Long
    r = 1
    Set ms = Sheets("K-5 (5 Week FV Bar) PR")
    Application.ScreenUpdating = False
    On Error Resume Next
    ms.Range("A8:U8").ClearContents
    For Each cell In Sheets("K-5 (5 Week FV Bar)").Range("CZ9:DD34, CZ363:CZ365")
    
        If Not IsError((cell)) Then
            If Len(cell) Or Len(cell.Text) Then
            ms.Cells(8, r).Value = cell.Value
            r = r + 1
            End If
        End If
    Next cell
    Application.ScreenUpdating = True
    Set ms = Nothing
    End Sub

I only want it to go from column A to E in worksheet K-5 (5 Week FV Bar) PR. I just need for it to skip rows. There are going to be empty cells in column DC in worksheet K-5 (5 Week FV Bar).

If it won't work, I can use my original code that does, but it only copies over 1 column at a time. I was trying to save myself from writing a bunch of code, but if there's no way else, then I'll have to do it.

I really do appreciate your help. Your code "If Len(cell) > 0 Or Len(cell.Text) > 0 Then" helped make the code work for some problem cells that were giving me run-time errors.

Sub W1Monday_Copy_ShortName()
    Dim cell As Range, r As Long
    r = 8
    Application.ScreenUpdating = False
    Sheets("K-5 (5 Week FV Bar) PR").Range("A8:A33").ClearContents
    For Each cell In Sheets("K-5 (5 Week FV Bar)").Range("CZ9:CZ34, CZ363:CZ365")
        If Len(cell) > 0 Or Len(cell.Text) > 0 Then
            Sheets("K-5 (5 Week FV Bar) PR").Range("A" & r).Value = cell.Value
            r = r + 1
        End If
    Next cell
    Application.ScreenUpdating = True
    End Sub

I think my last code #12 does copy only up to E. If a cell is empty, or show an error, the code skipps that cell. Have you tried it?

I tried it, but it still goes across. Thanks for trying. I really do appreciate it.

Untitled.jpg

I am now confused. One minute you want to copy down then across and now down again.Please note that I have not looked at the range you want to copy, but I did not see any issue with the above code. Now, I have reversed it going down, you have two options-Down and Across

Sub Copy_ShortName_to_PR_W1Monday()
    Dim cell As Range, r As Long
    r = 8
    Set ms = Sheets("K-5 (5 Week FV Bar) PR")
    Application.ScreenUpdating = False
    On Error Resume Next
    ms.Range("A8:E33").ClearContents
    For Each cell In Sheets("K-5 (5 Week FV Bar)").Range("CZ9:DD34, CZ363:CZ365")
    
        If Not IsError((cell)) Then
            If Len(cell) Or Len(cell.Text) Then
            ms.Cells(r, 1).Value = cell.Value
            r = r + 1
            End If
        End If
    Next cell
    Application.ScreenUpdating = True
    Set ms = Nothing
    End Sub

Thank you for your help!