Create Macro

[pratyush9991]

Hi,
I have a VBA code,I want to run 200 times for every next row.but I can't.please help.

Sub Test()
'
' Test Macro
'


'


    Range("Q3").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Sheets("Creator").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlToRight).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("R3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

 

[BrianJN1]

Re: Please Help to Create Macro

With respect, I am not clear as to what you need.
I have a small understanding that you want to copy and paste something from Sheet("Creator") into Sheet1 200 times.

Please clarify.

 

[pratyush9991]

Re: Please Help to Create Macro

Yes.I create this VBA code using Recording mode to copy and paste something from Sheet("Creator") into Sheet1 for A2 row.and I want this process will run till A200 row or some desired row value.

 

[pratyush9991]

Re: Please Help to Create Macro

Yes.I create this VBA code using Recording mode to copy and paste something from Sheet("Creator") into Sheet1 for A2 row.and I want this process will run till A200 row or some desired row value.

 

[BrianJN1]

Re: Please Help to Create Macro

Ok,
when I address your macro there is much that is irrelevant.
This works for the macro as you offered:

Sub Test2()
'
' Test Macro
'


'

Sheets("Creator").Select
Range("Q3").Copy
'
Sheets("Sheet1").Select
Range("R3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Your original macro says, with my coloured highlights of what I deleted:

Sub Test()
'
' Test Macro
'


'


    Range("Q3").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    [COLOR=#800000][I]Sheets("Creator").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlToRight).Select
    Application.CutCopyMode = False
    Selection.Copy[/I][/COLOR]
    Sheets("Sheet1").Select
    Range("R3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Now, with that stuff out of the way how do we progress? It seems that we need to look for the last row of one of those sheets but based on which column?

 

[pratyush9991]

Re: Please Help to Create Macro

This is my creator sheet

And this is my Sheet1

What I want to do:
1: copy the data from sheet 1

2: paste the data to creator sheet

3: After that a value will reflected in RSL value

4.Select the RSL value, copy it and paste to my Sheet 1

5. I need to carry on this process until 200 times.

 

[pratyush9991]

Re: Please Help to Create Macro

Thanks for helping.please share your mail Id,I can share the file what I can do.Please.

 

[JackDanIce]

Try:

Sub Test2()

    Dim arr()   As Variant
    Dim x       As Long
    Dim c       As Long
    Dim LR      As Long
    Dim r       As Range
            
    With ActiveSheet
        LR = .Range("Q" & .Rows.Count).End(xlUp).row
        For x = 3 To LR
            c = .Cells(3, 17).End(xlToLeft).column
            arr = .Cells(x, c).Resize(, 16 - x).Value
            Set r = Sheets("Creator").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            r.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
            Erase arr
            c = r.End(xlToRight).column
            arr = r.Resize(, c).Value
            Sheets("Sheet1").Cells(x, 18).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
            Erase arr
            Set r = Nothing
        Next x
    End With
            
End Sub

 

[pratyush9991]

Not running