Hello,

I need to copy 'activeXworksheet.xls' contents into another worksheet.
Cells I want to copy and then paste a B94:B103, O94:O103, W94:W103,
AA94:AA103, W118:127, AA118:AA127.

This data (6 referece columns) I want to be placed onto another
worksheet, where I have my cursor on it. Could you help me with the
macro? How to write one?

Thanks,

macXpert


--
macxpert
------------------------------------------------------------------------
macxpert's Profile: http://www.excelforum.com/member.php...o&userid=28414
View this thread: http://www.excelforum.com/showthread...hreadid=480102

Hello macExpert,

It is not clear from your post if you have 2 workbooks open. You say
you want to copy the data from the workbook 'activeXworksheet.xls' to
another worksheet. The question is that worksheet in the same workbook
or a different one? I am assuming also that the data will be copied to
the same cells on the new worksheet regardless of where the cursor is
on the new worksheet.

Post back and let me know if I am hot or cold with what you want. You
can also contact me by email .

SIncerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=480102

Hello Leith,

Thanks for showing your keenness.

I want to copy mentioned data from one workbook to another workbook.
The destination workbook will remain the same but source workbook will
be diffrent each time with constant references.

And if the data is copied on destination workbook regardless where the
cursor is then how can I manage dataflow onto destination file. I don't
want data to spilt over the occupied cells. It would be acceptable too
if it leaves next 2 or 3 rows blank and then start copying data
again...

Does this explanation made myself more clear? Let me know.

Thanks again.

macXpert


--
macxpert
------------------------------------------------------------------------
macxpert's Profile: http://www.excelforum.com/member.php...o&userid=28414
View this thread: http://www.excelforum.com/showthread...hreadid=480102

Hello macXpert,

I have a clearer picture of what you want. Just want to quickly recap
the process before I start coding.

The source workbook data is always in the same place (the 6 reference
columns) B94:B103, O94:O103, W94:W103, AA94:AA103, W118:127,
AA118:AA127, just different workbooks. In the destination workbook,
which is always the same, you want to copy this data starting where the
cursor is (the selected cell).

Just to be sure I understand, you want all of the data to be copied
into the same column where the cursor is and have a row or two
separating the groups, right? One more question. Will have more than 2
workbooks open at the time?


Thanks,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=480102

Hello macXpert,

Here is the macro code. You will need to copy and paste this code into
a VB Module. First run the Macro called "*AddToCellMenu*". This adds a
command to the Excel's Cell Popup Menu. Just right click the cell in
the destination Workbook and click "*Insert Rows/ Paste Here*". This
calls the "*MainMacro*", inserts the rows needed, and copies the 6
reference columns into the column of the active cell in the destination
workbook. One empty line separates each of the source columns from the
next one.

When the macro runs it checks the open workbooks and lists them in an
input box. Enter the name of the workbook to be used as the source. I
did it this way to keep it simple. This way you can have multple
workbooks open, and not be limited to only 2 - the source and
destination.

MACRO CODE:

Code:
--------------------
Public Sub MainMacro()

Dim Col As Long
Dim DstRng As Range
Dim DstWkb As Workbook
Dim DstWks As Worksheet

Dim Msg As String
Dim R As Long
Dim RowStart As Long

Dim SrcRng As Range
Dim SrcWkb As Workbook
Dim SrcWks As Worksheet
Dim WB


On Error GoTo Fault

Msg = "Enter the name of the Source Workbook" & vbCrLf _
& "from the ones listed below." & vbCrLf _
& "=====================================" & vbCrLf

For Each WB In Excel.Workbooks
If WB.Name < ThisWorkbook.Name And WB.Path < "" Then
Msg = Msg & WB.Name & vbCrLf
R = R + 1
End If
Next WB

If R = 0 Then
MsgBox "You Have No Saved Workbooks Open.", vbInformation + vbOKOnly
Exit Sub
End If

WB = InputBox(Msg, "Insert and Copy Data")
If WB = "" Then Exit Sub

'Setup the Workbooks and Worksheets
Set SrcWkb = Excel.Workbooks(WB)
SrcWkb.Activate
Set SrcWks = SrcWkb.ActiveSheet

Set DstWkb = ThisWorkbook
DstWkb.Activate
Set DstWks = DstWkb.ActiveSheet

'Get the Starting Row and Column from the ActiveCell
RowStart = ActiveCell.Row
Col = ActiveCell.Column

'Source Range Addresses
Set SrcRng = SrcWks.Range("B94:B103"): GoSub InsertAndCopy
Set SrcRng = SrcWks.Range("O94:O103"): GoSub InsertAndCopy
Set SrcRng = SrcWks.Range("W94:W103"): GoSub InsertAndCopy
Set SrcRng = SrcWks.Range("AA94:AA103"): GoSub InsertAndCopy
Set SrcRng = SrcWks.Range("W118:W127"): GoSub InsertAndCopy
Set SrcRng = SrcWks.Range("AA118:AA127"): GoSub InsertAndCopy

Exit Su


'_________________________________________


InsertAndCopy:

Set DstRng = ActiveCell.Resize(SrcRng.Rows.Count + 1, Col)
DstRng.Insert (xlDown)

For R = 1 To SrcRng.Rows.Count
DstWks.Cells(RowStart + R - 1, Col).Value = SrcRng.Item(R, 1).Value
Next R

RowStart = RowStart + R
DstWks.Cells(RowStart, Col).Select

Return

Fault:

Msg = "There is a problem with the Workbook " & WB & vbCrLf _
& "Error Number " & Err.Number & vbCrLf _
& "Description: " & Err.Description

MsgBox Msg, vbCritical + vbOKOnly, "InsertRowsPasteHere Macro"

End Sub

Public Sub AddToCellMenu()

'Add Macro command to the Cell Popup Menu

Dim cbCell As CommandBar
Dim ctButton As CommandBarButton
Dim ctDropDown As CommandBarControl
Dim WB

Set cbCell = Excel.CommandBars("cell")

Set ctButton = cbCell.Controls.Add
With ctButton
.Caption = "Insert Rows/Paste Here"
.OnAction = "MainMacro"
.BeginGroup = True
End With

End Sub

--------------------


--
Leith Ross


------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=480102