I don't want to have 30 posting again like the last time I helped you. The
code I posted would of done everything. You keep on going backwards rather
than forward in solving the problems. work with my code and let me k now what
the problems are. The method you are using worn't work for multiple pages.
Compare my code carefully against your code and you will see all the changes
I made that you left out.

"ytayta555" wrote:

On 8 Mai, 13:29, joel wrote:

Thank you so much , so glad to meet you again , old saviour

I changed Dim NextRow As Long with Dim NextColumn As Long,
and next code work perfect for me , except a part :

Sub AAACOLUMNSNEW()
Application.ScreenUpdating = True

Dim FromWks1 As Worksheet
Dim DestWks As Worksheet
Dim NextColumn As Long
Dim myCell As Range
Dim myRng1 As Range
Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long
Dim i5 As Long
Dim i6 As Long
Dim i7 As Long


Set FromWks1 = Workbooks("DATABASE Gr VALUE.xls").Worksheets("1")
Set DestWks = Workbooks("RAMSES1.xls").Worksheets("1")
With FromWks1
Set myRng1 = .Range("U2000:AN2000")
End With
With FromWks1
For i1 = 41 To 50
For i2 = i1 + 1 To 51
For i3 = i2 + 1 To 52
For i4 = i3 + 1 To 53
For i5 = i4 + 1 To 54
For i6 = i5 + 1 To 55
For i7 = i6 + 1 To 56
.Range("A2001:A3635") = .Range(Cells("1", i1), _
Cells("1635", i1)).Value
.Range("B2001:B3635") = .Range(Cells("1", i2), _
Cells("1635", i2)).Value
.Range("C2001:C3635") = .Range(Cells("1", i3), _
Cells("1635", i3)).Value
.Range("D2001:D3635") = .Range(Cells("1", i4), _
Cells("1635", i4)).Value
.Range("E2001:E3635") = .Range(Cells("1", i5), _
Cells("1635", i5)).Value
.Range("F2001:F3635") = .Range(Cells("1", i6), _
Cells("1635", i6)).Value
.Range("G2001:G3635") = .Range(Cells("1", i7), _
Cells("1635", i7)).Value

For Each myCell In myRng1.Cells
If myCell.Value = "OK" Then
With FromWks1
.Cells(myCell.Row, myCell.Column).AutoFill _
Destination:=.Range(.Cells(myCell.Row,
myCell.Column), .Cells(3635, myCell.Column))
.Range("A2001:G2001").Copy
.Range(.Cells("3641", myCell.Column), .Cells
("3647", myCell.Column)).PasteSpecial , _
Paste:=xlPasteValues, _
Transpose:=True
End With
Application.CutCopyMode = False
With DestWks
NextColumn = .Cells("1", .Columns.Count).Column +
1
myCell.EntireColumn.Copy
.Cells("1", NextColumn).PasteSpecial ,
Paste:=xlPasteValues
End With
.Range(.Cells("2001", myCell.Column), .Cells("3647",
myCell.Column)).ClearContents
End If
Next myCell
Application.CutCopyMode = False
Next i7
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
End With
Application.ScreenUpdating = True
End Sub

Absolute all my code work perfect , except this part :

With DestWks
NextColumn = .Cells("1", .Columns.Count).Column + 1
myCell.EntireColumn.Copy
.Cells("1", NextColumn).PasteSpecial , Paste:=xlPasteValues
End With

The code don't copy in DestWks in first column , from Row 1 ,
then in second Column (B), ......... to column IV , then to add a new
sheet (or copy in a next yet existing one , in first column ) , .....

Please again for help .