Copy paste block of cells when there's something in column A

[Bob L]

I have a block of cells (multiple rows and columns) that is the consolidation of every combination in the file. Under the conso, there's a block of cells for each combination. The combination are in columns A to C. So for each combination, I want Excel to copy/paste the first block of cells (like a template) to the other combination. It'll be easier to understand once you open the file.

Open the file located here: https://easyupload.io/87gwql

What I would want is a way (probably VBA) to copy cells E121 to AU236 and paste it on the same row where there is something in column A (so when column A <> 0 or ""). So in this example, it would paste it in E240 and E359. Then, copy/paste value everything under row 236 (so everything that's been copied). If possible, I would like the macro the delete everything under row 236 first, then copy/paste and copy/paste value.

The reason being that the data (and so the combinations) can change each month. Also, there will be functions in the block of cells, that's why we copy/paste first for them to recalculate based on the combination and then copy/paste value. For now, I've linked the combination in columns A to C manually, but there can be up to 150 combinations possible (which can be seen in the Master tab), so that's the reason for the copy/paste value, the file becomes slow otherwise.

Ask away if something isn't clear.

 

[maras]

Test it.

Sub test()
    Dim i As Integer
    Dim rng As Range, cel, dest As Range
    
    Application.ScreenUpdating = False
    With Sheets("Conso")
        Set rng = .Range("A122:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
        .Range("e121:au236").Copy
        For Each cel In rng.SpecialCells(xlCellTypeFormulas)
            Set dest = cel.Offset(, 4)
            dest.PasteSpecial (xlPasteAll)
        Next
    End With
    Application.CutCopyMode = False
    Set rng = Nothing
    Set dest = Nothing
End Sub

 

[Bob L]

Test it.

Sub test()
    Dim i As Integer
    Dim rng As Range, cel, dest As Range
   
    Application.ScreenUpdating = False
    With Sheets("Conso")
        Set rng = .Range("A122:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
        .Range("e121:au236").Copy
        For Each cel In rng.SpecialCells(xlCellTypeFormulas)
            Set dest = cel.Offset(, 4)
            dest.PasteSpecial (xlPasteAll)
        Next
    End With
    Application.CutCopyMode = False
    Set rng = Nothing
    Set dest = Nothing
End Sub

It does copy/paste it, but it doesn't copy/paste it value afterwards. If I delete a combination, it doesn't delete everything under row 236 before copy/pasting the cells E121:AU236. Also, it copies the block even when the formula = 0 in column A, but it shouldn't.

So the VBA should:
1) Delete everything under row 236
2) Copy cells E121:AU236 to every row that has something in column A, except when column A = 0 or "" (what your VBA does, except the 0 or "" part as you can see with the last combination on row 835 )
3) Everything that was copy in step 2, copy/paste value (so everything under row 236)

Or maybe I'm using your VBA wrong. Thanks for the help!!

 

[maras]

I think this does what you want.

Sub test()
    Dim i As Integer, lr As Integer
    Dim rng As Range, cel, dest As Range
    
    Application.ScreenUpdating = False
    With Sheets("Conso")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        
        With .Range("E239:AU" & lr + 120)
            .Delete
        End With
        Set rng = .Range("A122:A" & lr)
        
        .Range("E121:AU236").Copy
        For Each cel In rng.SpecialCells(xlCellTypeFormulas, 2)
            Set dest = cel.Offset(, 4)
            dest.PasteSpecial (xlPasteAll)
        Next
        
    End With
    Application.CutCopyMode = False
    Set rng = Nothing
    Set dest = Nothing
End Sub

 

[Bob L]

I think this does what you want.

Sub test()
    Dim i As Integer, lr As Integer
    Dim rng As Range, cel, dest As Range
  
    Application.ScreenUpdating = False
    With Sheets("Conso")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
      
        With .Range("E239:AU" & lr + 120)
            .Delete
        End With
        Set rng = .Range("A122:A" & lr)
      
        .Range("E121:AU236").Copy
        For Each cel In rng.SpecialCells(xlCellTypeFormulas, 2)
            Set dest = cel.Offset(, 4)
            dest.PasteSpecial (xlPasteAll)
        Next
      
    End With
    Application.CutCopyMode = False
    Set rng = Nothing
    Set dest = Nothing
End Sub

It does step 1 and 2 perfectly, it just doesn't copy/paste it values at the end (step 3). I entered a vlookup in cell I123 =VLOOKUP(A121,A:C,3,0), just to see if it was changing for each copy/paste that your VBA does (it works), but you can see every vlookup under row 236 and not just the value. So if you test with my vlookup in cell I123, then run your VBA, look at cell I242 and you'll see =VLOOKUP(A240,A:C,3,0) and not Apple (the value).

I can always do it manually if it's too much of a hassle.

Thanks!!

 

[maras]

Corrected code. It should be OK.

Sub test()
    Dim i As Integer, lr As Integer
    Dim rng As Range, cel, dest As Range, rngToCopy As Range
    
    Application.ScreenUpdating = False
    With Sheets("Conso")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        
        .Range("E239:AU" & lr + 120).Delete
        
        Set rng = .Range("A122:A" & lr)
        Set rngToCopy = .Range("E121:AU236")
        
        rngToCopy.Copy
        For Each cel In rng.SpecialCells(xlCellTypeFormulas, 2)
            Set dest = cel.Offset(, 4)
            dest.PasteSpecial (xlPasteAll)
            With dest.Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count)
                .Value = .Value
            End With
        Next
        
    End With
    Application.CutCopyMode = False
    Set rng = Nothing
    Set dest = Nothing
    Set rngToCopy = Nothing
End Sub

 

[Bob L]

Corrected code. It should be OK.

Sub test()
    Dim i As Integer, lr As Integer
    Dim rng As Range, cel, dest As Range, rngToCopy As Range
   
    Application.ScreenUpdating = False
    With Sheets("Conso")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
       
        .Range("E239:AU" & lr + 120).Delete
       
        Set rng = .Range("A122:A" & lr)
        Set rngToCopy = .Range("E121:AU236")
       
        rngToCopy.Copy
        For Each cel In rng.SpecialCells(xlCellTypeFormulas, 2)
            Set dest = cel.Offset(, 4)
            dest.PasteSpecial (xlPasteAll)
            With dest.Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count)
                .Value = .Value
            End With
        Next
       
    End With
    Application.CutCopyMode = False
    Set rng = Nothing
    Set dest = Nothing
    Set rngToCopy = Nothing
End Sub

Yep, it works perfectly! Huge thanks!!