Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Can't Copy and Paste or Paste Special between Excel Workbooks | Excel Discussion (Misc queries) | |||
Automating copy/paste/paste special when row references change | Excel Programming | |||
help w/ generic copy & paste/paste special routine | Excel Programming | |||
Excel cut/Paste Problem: Year changes after data is copy and paste | Excel Discussion (Misc queries) | |||
Copy and Paste macro needs to paste to a changing cell reference | Excel Programming |