LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,670
Default copy and paste

Good morning JLGWhiz or anyone else....
I was looking through the posts to see if you were able to post the
corrected macro before you left for the day, since you said you would try in
the evening or today. Unfortunetly I couldn't find any of the posts from our
conversation. What happened to them? Just in case here is the macro you
gave me.

Private Sub ListBox1_Click()

Dim ws As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim lr4, lc4, mCnt, cnt As Long

lr4 = Sheets("last four").Cells(Rows.count, 2).End(xlUp).Row
lc4 = Sheets("last four").UsedRange.Columns.count + 1

Set ws = Sheets("test Database")
Set rng = ws.Range("B26:AD2500")
Sheets("test Database").Range("A25").Value = ListBox1.Value
For i = 0 To UserForm6.ListBox1.ListCount - 1
If UserForm6.ListBox1.Selected(i) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

ws.AutoFilterMode = False
rng.AutoFilter field:=1, Criteria1:="=" & ws.Range("A25").Value
ws.AutoFilter.Range.Copy
With Sheets("last four")
..Range("B2500").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlValues, operation:=xlNone, _
skipblanks:=False, Transpose:=False

ws.AutoFilterMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
Next

myvar4 = UserForm6.ListBox1.Selected(i)
mCnt = Application.CountIf(.Range("B72:B" & lr4), myvar4)

If mCnt = 4 Then
mCnt = 4
End If
cnt = 1
For i = lr4 To 72 Step -1
If .Cells(i, 2) = myvar4 Then
If cnt <= 4 Then
.Range("A9:Z12").ClearContents
Select Case mCnt

Case Is = 1
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B9").PateSpecial Paste:=xlPasteValues

Case Is = 2
If x = "" Then x = 10
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 3
If x = "" Then x = 11
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

Case Is = 4
If x = "" Then x = 12
.Range(.Cells(i, 2), .Cells(i, lc4)).Copy
.Range("B&x").PateSpecial Paste:=xlPasteValues
x = x - 1

End Select
cnt = cnt + 1
End If
End If
Next
End With

Range("S14").Select
'sheets("last four").protect "1dickson"

End Sub

Eric
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Can't Copy and Paste or Paste Special between Excel Workbooks wllee Excel Discussion (Misc queries) 5 April 29th 23 03:43 AM
Automating copy/paste/paste special when row references change Carl LaFong Excel Programming 4 October 8th 07 06:10 AM
help w/ generic copy & paste/paste special routine DavidH[_2_] Excel Programming 5 January 23rd 06 03:58 AM
Excel cut/Paste Problem: Year changes after data is copy and paste Asif Excel Discussion (Misc queries) 2 December 9th 05 05:16 PM
Copy and Paste macro needs to paste to a changing cell reference loulou Excel Programming 0 February 24th 05 10:29 AM


All times are GMT +1. The time now is 11:40 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"