PDA

View Full Version : Copy & Paste data from column I



Pete
06-06-2008, 03:05 AM
See attached workbook.......Vol -1 .xls

Hi

Been trying to copy the data from column I worksheet"Deal Selection" and add it to worksheet "Volume Summary" using the same functionality as the macro in module 1.

But this pasting the data into the demand section as highlighted in green..

Pete
06-06-2008, 03:44 AM
The origianl code was so excellent done by xld

Pete
06-06-2008, 04:56 AM
Being try to do this my self. Cannot work out which part of the code will copy column I and paste it.

Bob Phillips
06-06-2008, 05:05 AM
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("Supply", "Obligations", Numrows)
Call CopyData("Supply", "Actual Allocations", Numrows)
Call CopyData("Demand", "Surplus/Shortages", Numrows)

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Private Sub CopyData(ByVal SectionFrom As String, ByVal SectionTo As String, ByVal Numrows As Long)
Dim SalesRow As Long
Dim TargetRows As Long
Dim SourceCell As Range
Dim BaseCell As Range
Dim cell As Range

With Worksheets("Deal Selection")

Set SourceCell = .UsedRange.Find(SectionFrom)
If SourceCell Is Nothing Then

MsgBox "Problem with data to be copied"
Exit Sub
End If
End With

With Worksheets("Volume Summary")

Set cell = .Columns(2).Find(SectionTo)
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

SourceCell.Offset(3, 0).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

Pete
06-06-2008, 05:27 AM
Hi xld

Firstly, apologies if this is a rude question. Does this copy column I from worksheet "Deal Selection"????

Bob Phillips
06-06-2008, 05:29 AM
Try it and see.

Pete
06-06-2008, 05:34 AM
It does....like i said apologies......but it is posting the end result in the wrong row in column B worksheet "Volume Summary"......

The end results need to be in row 26, 62 and 98 column B worksheet "Volume Summary" these are the starting point fror the demand clients