T
trward79
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
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