Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change a Macro - Copy in Columns instead of copy in Rows
HI , and a good day to all programmers
I have actually the next macro : Sub AAACOLUMNS() Application.ScreenUpdating = True Dim FromWks1 As Worksheet Dim DestWks As Worksheet Dim NextRow 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("A2000:T2000") 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 .Range("A" & myCell.Row).AutoFill _ Destination:=.Range("A" & myCell.Row & ":G" & myCell.Row), Type:=xlFillDefault .Range("A1:A7").Copy .Range("DA" & myCell.Row & ":DG" & myCell.Row).PasteSpecial , Paste:=xlPasteValues, Transpose:=True End With Application.CutCopyMode = False With DestWks NextRow = .Cells(.Rows.Count, "CY").End(xlUp).Row + 1 myCell.EntireRow.Copy .Cells(NextRow, "A").PasteSpecial , Paste:=xlPasteValues End With Range("CX" & myCell.Row & ":AJ" & myCell.Row).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 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ __ __ _ 1) What I need now is , to copy and to do autofill in Columns , not in Rows ; so , I have myRng1 = .Range("A2000:T2000") If myCell.Value = "OK" Then _ then to do autofill from row 2000 & myCell to 3635 & myCell , instead of ......... .... .Range("A" & myCell.Row).AutoFill _ Destination:=.Range("A" & myCell.Row & ":G" & myCell.Row), Type:=xlFillDefault Actually , this code do the autofill in myCell.Row 2) After this autofill , the code must copy entire Column (not Row!) , ( myCell Column ) and copy it in the second workbook (named "RAMSES1.xls"), in first column , then in second , from Column A to Column IV (I use xl 2003) ; 2 a ) When the first worksheet is full (column265) , to copy it in second worksheet (named "2") , in column A , and so on ... It mean , what I need is , what code was done from past time until now in Rows , to do it in Columns !..!... Maybe I shall came back later with a last question in my problem ; Please very much to provide me this changes in this code |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change a Macro - Copy in Columns instead of copy in Rows
Sub AAACOLUMNS()
Application.ScreenUpdating = True Dim FromWks1 As Worksheet Dim DestWks As Worksheet Dim NextRow 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 Destbk = Workbooks("RAMSES1.xls") DestCol = 1 With FromWks1 Set myRng1 = .Range("A2000:T2000") 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 First = True For Each myCell In myRng1.Cells If myCell.Value = "OK" Then With FromWks1 .Cells(myCell.Row, myCell.Column).Copy _ Destination:= _ .Range(.Cells(myCell.Row, myCell.Column), _ .Cells(3635, myCell.Column)) If DestCol = 1 Then With Destbk Destbk.Sheets.Add _ after:=.Sheets(.Sheets.Count) Set DestWks = ActiveSheet End With End If .Range(.Cells(myCell.Row, myCell.Column), _ .Cells(3635, myCell.Column)).Copy DestWks.Cells(1, DestCol).PasteSpecial , _ Paste:=xlPasteValues DestCol = DestCol + 1 If DestCol Columns.Count Then DestCol = 1 End If 'do this code once If First = True Then .Range("A1:A7").Copy .Range("DA" & myCell.Row & ":DG" & _ myCell.Row).PasteSpecial , _ Paste:=xlPasteValues, _ Transpose:=True First = False End If End With Application.CutCopyMode = False Range("CX" & myCell.Row & _ ":AJ" & myCell.Row).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 "ytayta555" wrote: HI , and a good day to all programmers I have actually the next macro : Sub AAACOLUMNS() Application.ScreenUpdating = True Dim FromWks1 As Worksheet Dim DestWks As Worksheet Dim NextRow 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("A2000:T2000") 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 .Range("A" & myCell.Row).AutoFill _ Destination:=.Range("A" & myCell.Row & ":G" & myCell.Row), Type:=xlFillDefault .Range("A1:A7").Copy .Range("DA" & myCell.Row & ":DG" & myCell.Row).PasteSpecial , Paste:=xlPasteValues, Transpose:=True End With Application.CutCopyMode = False With DestWks NextRow = .Cells(.Rows.Count, "CY").End(xlUp).Row + 1 myCell.EntireRow.Copy .Cells(NextRow, "A").PasteSpecial , Paste:=xlPasteValues End With Range("CX" & myCell.Row & ":AJ" & myCell.Row).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 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ __ __ _ 1) What I need now is , to copy and to do autofill in Columns , not in Rows ; so , I have myRng1 = .Range("A2000:T2000") If myCell.Value = "OK" Then _ then to do autofill from row 2000 & myCell to 3635 & myCell , instead of ......... .... .Range("A" & myCell.Row).AutoFill _ Destination:=.Range("A" & myCell.Row & ":G" & myCell.Row), Type:=xlFillDefault Actually , this code do the autofill in myCell.Row 2) After this autofill , the code must copy entire Column (not Row!) , ( myCell Column ) and copy it in the second workbook (named "RAMSES1.xls"), in first column , then in second , from Column A to Column IV (I use xl 2003) ; 2 a ) When the first worksheet is full (column265) , to copy it in second worksheet (named "2") , in column A , and so on ... It mean , what I need is , what code was done from past time until now in Rows , to do it in Columns !..!... Maybe I shall came back later with a last question in my problem ; Please very much to provide me this changes in this code |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change a Macro - Copy in Columns instead of copy in Rows
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 . |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change a Macro - Copy in Columns instead of copy in Rows
On 8 Mai, 18:18, ytayta555 wrote:
Absolute all my code work perfect , except this part : I tried and so : 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 If DestCol = 1 Then With DestWks DestWks.Sheets.Add _ after:=.Sheets(.Sheet.Count) Set DestWks = ActiveSheet End If DestWks.Cells(1, DestCol).PasteSpecial , _ Paste:=xlPasteValues DestCol = DestCol + 1 If DestCol Columns.Count Then DestCol = 1 End If End With .Range(.Cells("2001", myCell.Column), .Cells ("3647", myCell.Column)).ClearContents End If but is highlighting the next part : after:=.Sheets(.Sheet.Count) , word Sheet in (.Sheet.Count) . |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change a Macro - Copy in Columns instead of copy in Rows
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 . |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change a Macro - Copy in Columns instead of copy in Rows
On 8 Mai, 18:47, joel wrote:
OK OK , I'll work , but only this part solve my problem : 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 It is OK and without Add-ing another sheets , only to paste in DestWks , Worksheet("1") , in Columns . Thank you so much |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change a Macro - Copy in Columns instead of copy in Rows
Your request asked for multiple worksheets So I had to do the following
1) Create the variable for the workbook Set Destbk = Workbooks("RAMSES1.xls") 2) Use variable DestCol to keep track of the column we are writing to rather than keep on using END() method which causes problems when you get to the last column 3) When DestCol gets to 256 set it back to one and create a new worksheet. "ytayta555" wrote: On 8 Mai, 18:47, joel wrote: OK OK , I'll work , but only this part solve my problem : 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 It is OK and without Add-ing another sheets , only to paste in DestWks , Worksheet("1") , in Columns . Thank you so much |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change a Macro - Copy in Columns instead of copy in Rows
On 8 Mai, 20:21, joel wrote:
Your request asked for multiple worksheets So I had to do the following I GET IT !! I worked with your code , but forever highlighting the next part : after:=.Sheets(.Sheet.Count) , the word ,,Sheet,, from (.Sheet.Count) . (I tried and with ,,Sheets" ... ) So , why I needed to put the result in entire Column , was to check then the data , but , now , I inserted a UDF function which show me the result I need ; with Transpose method , I could still keep my old code , and the code copy the results I need in rows (I'll have not more then 65536 results ) UDF : http://groups.google.ro/group/micros...690a05b5ce5?q= Here is my code : Sub AAACOLUMNSOK() Application.ScreenUpdating = True Dim FromWks1 As Worksheet Dim DestWks As Worksheet Dim NextRow 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("3640", myCell.Column), .Cells ("3647", myCell.Column)).PasteSpecial , _ Paste:=xlPasteValues, _ Transpose:=True .Range("A2000:C2000").Copy .Cells("3636", myCell.Column).PasteSpecial , _ Paste:=xlPasteValues, _ Transpose:=True myCell.Offset(-3, 0).FormulaR1C1 = "=cuR(R[3] C:R[55]C)" End With Application.CutCopyMode = False With FromWks1 .Range(.Cells("1997", myCell.Column), .Cells("2050", myCell.Column)).Copy End With With DestWks NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 .Cells(NextRow, "A").PasteSpecial , Paste:=xlPasteValues, _ Transpose:=True End With .Range(.Cells("2001", myCell.Column), .Cells("3633", myCell.Column)).ClearContents myCell.Offset(-3, 0).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 Thank you very much for helped me again , HAVE A GREAT WEEKEND . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Change macro to copy variable amount of rows instead of just 1? | Excel Programming | |||
Macro to copy formula to all rows that contain data in columns A:C | Excel Programming | |||
Macro simplifying - copy rows to worksheets based on values in 2 different columns | Excel Programming | |||
Copy columns to last populated rows | Excel Programming | |||
Copy Data to Rows instead of Columns | Excel Programming |