Thread: copy and paste
View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Eric Eric is offline
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