View Full Version : Solved: Copy & Paste and Adjust Data
See attached workbook.......Vol.xls
Hi
Need a macro to cut copy and past data from column B worksheet "Deal Selection" into highlighted section in worksheet "Volume"..... in grey
The tables in worksheet "Vol" column B need to adjust as the data in column B worksheet "Deal Selection" increase or decrease...
Bob Phillips
06-06-2008, 01:33 AM
Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim NumRows As Long
Dim SalesRow As Long
Dim TargetRows As Long
Dim cell As Range
With Application
' .ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With Worksheets("Deal Selection")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
NumRows = LastRow - 8
End With
With Worksheets("Volume Summary")
Set cell = .Columns(2).Find("Sale Contracts")
If Not cell Is Nothing Then
SalesRow = cell.Row
TargetRows = SalesRow - 9 - 2
If TargetRows < NumRows Then
.Rows(10).Resize(NumRows - TargetRows).Insert
ElseIf TargetRows > NumRows Then
.Rows(10).Resize(TargetRows - NumRows).Delete
End If
Worksheets("Deal Selection").Cells(9, "B").Resize(NumRows).Copy .Range("B9")
With .Range("B9").Resize(NumRows).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
thanks for the excellent feed back...... i am guessing i can change column B to I to repeart the procees for the other column...
Bob Phillips
06-06-2008, 02:06 AM
Yes, b ut if you are doing that two things to consider.
Firstly, is each block the same size. The code actively uses the size. Then, you should look to put the repeated code into a sub procedure, to cut dow the code and make it easier to maintain.
Xld....if i was to also insert the same data into column b Worksheet "Volume Summary" re: Highlighted sectionsin yellow.......how would this be done...
see new work book attached
Bob Phillips
06-06-2008, 02:44 AM
Public Sub Process_Supply()
Dim i As Long
Dim LastRow As Long
Dim Numrows As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With Worksheets("Deal Selection")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Numrows = LastRow - 8
End With
Call CopyData("Obligations", Numrows)
Call CopyData("Actual Allocations", Numrows)
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Private Sub CopyData(ByVal Section As String, ByVal Numrows As Long)
Dim SalesRow As Long
Dim TargetRows As Long
Dim BaseCell As Range
Dim cell As Range
With Worksheets("Volume Summary")
Set cell = .Columns(2).Find(Section)
If Not cell Is Nothing Then
Set BaseCell = cell.Offset(5, 0)
Set cell = .Columns(2).Find(What:="Sale Contracts", after:=cell)
If Not cell Is Nothing Then
SalesRow = cell.Row
TargetRows = SalesRow - BaseCell.Row - 2
If TargetRows < Numrows Then
.Rows(BaseCell.Row + 1).Resize(Numrows - TargetRows).Insert
ElseIf TargetRows > Numrows Then
.Rows(BaseCell.Row + 1).Resize(TargetRows - Numrows).Delete
End If
Worksheets("Deal Selection").Cells(9, "B").Resize(Numrows).Copy BaseCell
With BaseCell.Resize(Numrows).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
End If
End With
End Sub
Thank you work like a dream.......thank you once again for the feedback.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.