![]() |
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 |
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 |
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 |
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 |
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