Thread: Macro broken - copy data range column to empty data range column

Hi all,
I have this macro that has been working great for many moons but recently died. Here is what it does:

• Copy range of data (single column AI11:AI36)

• Cycle through a range of columns to find the first available blank range (Multiple columns H11:T36) that is empty and pastes values of copy.

• Copy range AC11:AC36 and paste values in AI11:AI36.

About a month ago it just stopped working. I can't tell you why, nothing in the code or spreadsheet has changed. There are no errors. The code runs, but no data is copied over to the blank cells. However, it does perform the last step which is to copy the data from AC11:AC36 and paste values in AI11:AI36. So I am sure it is something in the For Each iteration.

The code is below. It is an old macro, something that was done for me on this forum over a year ago.

I have attached a spreadsheet, it is close to the original as I can get without violating company privacy policy, and I need this to cycle through multiple sheets, which I am sure I can do on my own. My big thing is I can't seem to debug why the function it is not working.

For Each Cell in DstRng

Sub WEEKLY_WFMPortfolio_CopyFormula()
'
' WEEKLY_WFMPortfolio_CopyFormula Macro
'

'
  Dim Cell As Range
  Dim DstCell As Range
  Dim RngEnd As Range
  Dim SrcRng As Range
  
    Set DstRng = Range("H11:T11")
    Set SrcRng = Range("AI11:AI36")
    Set RngEnd = Cells(Rows.Count, SrcRng.Column).End(xlUp)
    Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, Range(SrcRng, RngEnd))

      For Each Cell In DstRng
        If WorksheetFunction.CountA(Cell.Resize(SrcRng.Rows.Count, 1)) = 0 Then
           Cell.Resize(SrcRng.Rows.Count, 1).Value = SrcRng.Value
           Exit For
        End If
      Next Cell
    Range("AC11:AC36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AH11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.LargeScroll ToRight:=-1
    Range("B3").Select
    
End Sub

Yes, that file does run the code. Wierd. I can't explain that either. i will go back to my, non-stripped out version, and see what the difference is.....besides a TON of formulas removed. I will move to solved and post what I found, if anything.

Still not working. I did a counta on columns H11:T11 and column T is now blank, as I manualy updated last time. The only part that worked was copying AC11:AC36 to AI11:AI36. Not sure why. No errors at all. I am having a hard time debugging as I didn't create this macro and don't understand exactly what this macro is doing, in laymens terms, for the loop. I "THINK" it is counting cells H11:T11 and attempting to find the number of columns over to count before dropping in the contents of AI11:AI36, but I don't show where it is actually copying the data from AI11:AI36.

Yet another update. It seems that the line which tried to judge how many rows to count, was coming up with some odd numbers. for example. The Rows.Count was pulling all rows in the worksheet in SrcRng.Column (which = 35 columns from left) and the final RngEnd number was 43.xxxxxxxxxx a lot of numbers. It should have only counted about 41 rows from the top and then do an .xlUp. So I hard coded it that way and now it is pulling normally.

The Problem is that on row 43 - 101, in the original sheet not posted, has information in the cells in column 35. Originally I wanted the code to look at each cell of rows=36 starting at cell row 11 of columns H:T to only paste values data from AI11:AI36 into the column with a countA = to zero. This modified version should work though.

Sub WEEKLY_WFMPortfolio_CopyFormula()
'
' WEEKLY_WFMPortfolio_CopyFormula Macro
'

'
  Dim Cell As Range
  Dim DstCell As Range
  Dim RngEnd As Range
  Dim SrcRng As Range
  
    Set DstRng = Range("H11:T11")
    Set SrcRng = Range("AI11:AI36")
    Set RngEnd = Cells(Rows.Count, SrcRng.Column).End(xlUp)
    Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, Range(SrcRng, RngEnd))

      For Each Cell In DstRng
        If WorksheetFunction.CountA(Cell.Resize(SrcRng.Rows.Count, 1)) = 0 Then
           Cell.Resize(SrcRng.Rows.Count, 1).Value = SrcRng.Value
           Exit For
        End If
      Next Cell
    Range("AC11:AC36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AH11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.LargeScroll ToRight:=-1
    Range("B3").Select
    
End Sub

Original Code

Sub WEEKLY_WFMPortfolio_CopyFormula()
'
' WEEKLY_WFMPortfolio_CopyFormula Macro
'

'
  Dim Cell As Range
  Dim DstCell As Range
  Dim RngEnd As Range
  Dim SrcRng As Range
  
    Set DstRng = Range("H11:T11")
    Set SrcRng = Range("AI11:AI36")
    Set RngEnd = Cells(41, SrcRng.Column).End(xlUp)
    Set SrcRng = IIf(RngEnd.Row < SrcRng.Row, SrcRng, Range(SrcRng, RngEnd))

      For Each Cell In DstRng
        If WorksheetFunction.CountA(Cell.Resize(SrcRng.Rows.Count, 1)) = 0 Then
           Cell.Resize(SrcRng.Rows.Count, 1).Value = SrcRng.Value
           Exit For
        End If
      Next Cell
    Range("AC11:AC36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("AH11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.LargeScroll ToRight:=-1
    Range("B3").Select

End Sub

Modified, slightly