ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Copy destination problem (https://www.excelbanter.com/excel-programming/354178-copy-destination-problem.html)

Casey[_49_]

Copy destination problem
 

Hi,
I have a routine that reads the selections made in a Listbox and
transfers the ranges on wks1 associated with those selections to wks2.
The problem I'm having is when there are multiple selections, the first
range will copy in the correct place, but then the subsequent ranges one
by one overwrite the first range. I need them to start pasting at Row 20
Column D and if the first range is 30 rows the next range would skip a
row and paste at Row 51 Column D. Here's my code including the code for
the listbox UserForm.

Option Explicit
Sub UserForm_Initialize()
Dim Cell As Range

ListBox1.Clear
For Each Cell In Range("ScopeTitles")
ListBox1.AddItem Cell.Value
Next
End Sub
Private Sub cmdCancel_Click()
SelectScopesForm.Hide
End Sub

Private Sub cmdInsertScopes_Click()
Dim SelCount, i As Integer
Dim ScopePicks() As Integer
Dim RCount, r, c As Long
Dim wks1 As Worksheet
Dim wks2 As Worksheet

Set wks1 = Worksheets("Scopes")
Set wks2 = Worksheets("Proposal")
' Hide the userform
SelectScopesForm.Hide
' Get count on rows
RCount = wks1.UsedRange.Rows.Count
SelCount = 0
For i = 0 To SelectScopesForm.ListBox1.ListCount - 1
If SelectScopesForm.ListBox1.Selected(i) Then
SelCount = SelCount + 1
If i = 0 Then
ReDim ScopePicks(i + 1)
Else
ReDim Preserve ScopePicks(SelCount)
End If
ScopePicks(SelCount - 1) = i + 1
End If
Next i
If SelCount 0 Then
' Loop through array and copy data from scopes selected
' in ListBox from Scopes worksheet to Proposal worksheet
For c = 0 To SelCount - 1
For r = 1 To RCount
' Here is the problem
wks2.Cells(r + 19, 4) = wks1.Cells(r, ScopePicks(c))
Next r
Next c
Else
MsgBox ("You didn't select any scopes.")
Exit Sub
End If
End Sub


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=515848


Casey[_50_]

Copy destination problem
 

Hi again,
I could really use some help. Once again I have cobbled together some
code from various places and it works................almost. Just a
little help please.


--
Casey


------------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=515848


Tom Ogilvy

Copy destination problem
 
Option Explicit
Sub UserForm_Initialize()
Dim Cell As Range

ListBox1.Clear
For Each Cell In Range("ScopeTitles")
ListBox1.AddItem Cell.Value
Next
End Sub
Private Sub cmdCancel_Click()
SelectScopesForm.Hide
End Sub

Private Sub cmdInsertScopes_Click()
Dim SelCount, i As Long
Dim ScopePicks() As Integer
Dim RCount as Long, r as Long, c As Long
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim rw as Long

Set wks1 = Worksheets("Scopes")
Set wks2 = Worksheets("Proposal")
' Hide the userform
SelectScopesForm.Hide
' Get count on rows
RCount = wks1.UsedRange.Rows.Count
SelCount = 0
For i = 0 To SelectScopesForm.ListBox1.ListCount - 1
If SelectScopesForm.ListBox1.Selected(i) Then
SelCount = SelCount + 1
If i = 0 Then
ReDim ScopePicks(i + 1)
Else
ReDim Preserve ScopePicks(SelCount)
End If
ScopePicks(SelCount - 1) = i + 1
End If
Next i
If SelCount 0 Then
' Loop through array and copy data from scopes selected
' in ListBox from Scopes worksheet to Proposal worksheet
rw = 1
For c = 0 To SelCount - 1
For r = 1 To RCount
' Here is the problem
wks2.Cells(rw + 19, 4) = wks1.Cells(r, ScopePicks(c))
rw = rw + 1
Next r
rw = rw + 1
Next c
Else
MsgBox ("You didn't select any scopes.")
Exit Sub
End If
End Sub

--
Regards,
Tom Ogilvy

"Casey" wrote in
message ...

Hi again,
I could really use some help. Once again I have cobbled together some
code from various places and it works................almost. Just a
little help please.


--
Casey


------------------------------------------------------------------------
Casey's Profile:

http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=515848




Casey[_51_]

Copy destination problem
 

Tom,
Exactly what I needed. The time on the answer (at least in my tim
zone) was 10:40 pm, do you crank this great code out during commercia
breaks watching Letterman? Thank you very much for the help

--
Case

-----------------------------------------------------------------------
Casey's Profile: http://www.excelforum.com/member.php...nfo&userid=454
View this thread: http://www.excelforum.com/showthread.php?threadid=51584


Tom Ogilvy

Copy destination problem
 
I just made a modification or two to your code - probably during the
Olympics <g

--
Regards,
Tom Ogilvy

"Casey" wrote in
message ...

Tom,
Exactly what I needed. The time on the answer (at least in my time
zone) was 10:40 pm, do you crank this great code out during commercial
breaks watching Letterman? Thank you very much for the help.


--
Casey


------------------------------------------------------------------------
Casey's Profile:

http://www.excelforum.com/member.php...fo&userid=4545
View this thread: http://www.excelforum.com/showthread...hreadid=515848





All times are GMT +1. The time now is 05:13 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com