Hi Howard,
Am Thu, 23 Jan 2014 04:37:21 -0800 (PST) schrieb L. Howard:
Here is the whole code and the similar sections of code DO NOT have the dot there and work fine. And works fine WITH dots in those locations. (I tried it both ways, all with dots and all with no dots and it works)
if you use a With statement the dot will refer explicit to the sheet in
this statement.
If you set a range without refering to a sheet VBA normally refers to
the active sheet.
ActiveWorkbook could be another workbook than the workbook with the
code. The workbook with the code in it is ThisWorkbook.
It is no worksheet event code. So the code should be in a standard
module.
If your ranges all have the same number of rows you only have to
calculate the last cell once. The other ranges can set using offset.
If you refer to the rows instead of copy and paste the code is a bit
faster:
Sub MyColDEFG()
Dim cG As Range
Dim Grng As Range
Dim cD As Range
Dim Drng As Range
Dim cE As Range
Dim Erng As Range
Dim cF As Range
Dim Frng As Range
Dim arrOut As Variant
Application.ScreenUpdating = False
With ActiveWorkbook.Worksheets("Sheet1")
Set Grng = .Range("G1:G" & .Range("G" & .Rows.Count).End(xlUp).Row)
For Each cG In Grng
If cG = "X" Then
cG.EntireRow.Cut Sheets("All Other") _
.Range("A" & Rows.Count).End(xlUp)(2)
End If
Next
Set Drng = Grng.Offset(, -3)
For Each cD In Drng
If cD <> "" And cD.Offset(, 2) = "" Then
arrOut = cD.Offset(, -3).Resize(1, 7)
Sheets("Tab 1").Range("D" & Rows.Count) _
.End(xlUp)(2).Resize(columnsize:=7) = arrOut
End If
Next
Set Erng = Grng.Offset(, -2)
For Each cE In Erng
If cE <> "" And cE.Offset(, 1) = "" Then
arrOut = cE.Offset(, -4).Resize(1, 7)
Sheets("Tab 2").Range("E" & Rows.Count) _
.End(xlUp)(2).Resize(columnsize:=7) = arrOut
End If
Next
Set Frng = Grng.Offset(, -1)
For Each cF In Frng
If cF = "W" Then
Sheets("Tab 3").Range("F" & Rows.Count).End(xlUp)(2) = cF
ElseIf cF = "O" Then
Sheets("Tab 1").Range("L" & Rows.Count).End(xlUp)(2) = cF
Sheets("Tab 2").Range("L" & Rows.Count).End(xlUp)(2) = cF
End If
Next
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Regards
Claus B.