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

Bob L

New Member
Joined
May 10, 2020
Messages
35
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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.
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

maras

New Member
Joined
Dec 12, 2019
Messages
31
Office Version
  1. 2010
Platform
  1. Windows
Test it.
VBA Code:
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

New Member
Joined
May 10, 2020
Messages
35
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Test it.
VBA Code:
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

New Member
Joined
Dec 12, 2019
Messages
31
Office Version
  1. 2010
Platform
  1. Windows
I think this does what you want.
VBA Code:
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

New Member
Joined
May 10, 2020
Messages
35
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

I think this does what you want.
VBA Code:
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

New Member
Joined
Dec 12, 2019
Messages
31
Office Version
  1. 2010
Platform
  1. Windows
Corrected code. It should be OK.
VBA Code:
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
 
Solution

Bob L

New Member
Joined
May 10, 2020
Messages
35
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Corrected code. It should be OK.
VBA Code:
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!! :)
 

Watch MrExcel Video

Forum statistics

Threads
1,122,529
Messages
5,596,694
Members
414,088
Latest member
rodriboraun

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top