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: 20
Default Have two hard issues... I can't seem to resolve!!!

I'm having several issues, and they are noted by ***ISSUE***

Sub Copy_Data()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim WS4 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim Str As String
Set WS1 = Sheets("Summary")
Set WS2 = Sheets("Credits")
Set WS3 = Sheets("Payroll")
Set WS4 = Sheets("Macros")


*** IF THERE ARE NO VALUES IN THE WS2.Range prior to running it places the ,
from concantenation, and then #VAL in the colums B,C,D,E,F ***

WS3.Select
Range("A5:AA1505").Select
Selection.Copy
WS4.Select
Range("A1").Select
ActiveSheet.Paste



Do Until IsEmpty(ActiveCell)
Set rng1 = WS4.Range("A2:AA1502").CurrentRegion
Str = WS4.Range("C2").Value
WS4.Select
WS4.AutoFilterMode = False
rng1.AutoFilter Field:=3, Criteria1:=Str
With WS4.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
.SpecialCells (xlCellTypeVisable)
WS2.Select
Range("K5").Select
Selection.Copy
WS1.Select
Range("A7").Select
Do While Not IsEmpty(Selection)
Selection.Offset(1, 0).Select
Loop
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False


If WS2.Range("AV9").Value = WS2.Range("AX3").Value Then
Cells(Selection.Row, "B").Value = WS2.Range("AV70").Value
End If
If WS2.Range("AV9").Value = WS2.Range("AX4").Value Then
Cells(Selection.Row, "C").Value = WS2.Range("AV70").Value
End If
If WS2.Range("AV9").Value = WS2.Range("AX5").Value Then
Cells(Selection.Row, "D").Value = WS2.Range("AV70").Value
End If
If WS2.Range("AV9").Value = WS2.Range("AX6").Value Then
Cells(Selection.Row, "E").Value = WS2.Range("AV70").Value
End If
If WS2.Range("AV9").Value = WS2.Range("AX7").Value Then
Cells(Selection.Row, "F").Value = WS2.Range("AV70").Value
End If

If WS2.Range("AW9").Value = WS2.Range("AX3").Value Then
Cells(Selection.Row, "B").Value = WS2.Range("AW70").Value
End If
If WS2.Range("AW9").Value = WS2.Range("AX4").Value Then
Cells(Selection.Row, "C").Value = WS2.Range("AW70").Value
End If
If WS2.Range("AW9").Value = WS2.Range("AX5").Value Then
Cells(Selection.Row, "D").Value = WS2.Range("AW70").Value
End If
If WS2.Range("AW9").Value = WS2.Range("AX6").Value Then
Cells(Selection.Row, "E").Value = WS2.Range("AW70").Value
End If
If WS2.Range("AW9").Value = WS2.Range("AX7").Value Then
Cells(Selection.Row, "F").Value = WS2.Range("AW70").Value
End If
WS2.Select
For Each cell In Range("AB10:AB69")
cell.EntireRow.Hidden = cell.Value = 0
Next cell
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True ',
Preview:=True
WS2.Select
Rows("10:70").Select
Selection.EntireRow.Hidden = False
WS2.Select
Range("A10:AA69").ClearContents
If Not rng2 Is Nothing Then
rng2.Copy WS2.Range("A1" & LastRow(WS2) + 0)
rng2.EntireRow.Delete
End If
End With
WS4.AutoFilterMode = False
WS4.Select
Range("C2").Activate
Loop
WS1.Select
For Each cell In Range("A8:A95")
cell.EntireRow.Hidden = cell.Value = ""
Next cell

***I NEED THE SHEET TO CLEAR THE VALUES OF THE CELLS THAT HAVE 0.00 AS THERE
VALUE***

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, Preview:=True
WS1.Select
Rows("7:95").Select
Selection.EntireRow.Hidden = False
WS1.Select
Range("A8:F94").ClearContents
WS2.Select
Range("A10:AA69").ClearContents
WS3.Select
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A2:AA1502"),
Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows,
SearchDirection:=xlPrevious, MatchCase:=False).Row
On Error GoTo 0
End Function
 
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
Is there a way to use Formula to resolve Sky Excel Worksheet Functions 5 May 7th 09 01:07 AM
#REF! Error Resolve? Dan the Man[_2_] Excel Worksheet Functions 2 July 30th 07 03:28 AM
Did you ever resolve this? [email protected] Excel Discussion (Misc queries) 1 April 24th 07 02:34 PM
how to resolve a printer name Bert van den Brink Excel Programming 1 July 30th 06 10:39 AM
Another issue to resolve Pat Excel Programming 11 February 20th 05 09:01 PM


All times are GMT +1. The time now is 11:27 AM.

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"