Copy Data Between Sheet

[JERRY89]

Dear All,

Is there a macro to transfer data between sheet in the same workbook based on the below criteria. I need a sample for me to work on it based on the below criteria.

1) Copy Data from Sheet2 Cell A2 until End to sheet 1 Cell B2
2) Copy Data from Sheet2 Cell A2 until End to sheet 1 Cell D2 (Text Length must 50-Can it capture before a space of the text if it exceed 50 character.)

[HansV]

1) This is simple:

Code: Select all

Sub Copy1()
    Dim m As Long
    With Worksheets("Sheet2")
        m = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A2:A" & m).Copy Destination:=Worksheets("Sheet1").Range("B2")
    End With
End Sub

2) This will be much slower because we have to look at each cell individually:

Code: Select all

Sub Copy2()
    Dim r As Long
    Dim m As Long
    Dim s As String
    Dim p As Long
    Application.ScreenUpdating = False
    With Worksheets("Sheet2")
        m = .Range("A" & .Rows.Count).End(xlUp).Row
        For r = 2 To m
            s = .Range("A" & r).Value
            If Len(s) > 50 Then
                p = InStrRev(s, " ", 50)
                s = Left(s, p - 1)
            End If
            Worksheets("Sheet1").Range("D" & r).Value = s
        Next r
    End With
    Application.ScreenUpdating = True
End Sub

[JERRY89]

Hi Hans,

Thanks a lot for this macro...Save a lot of my time..

[JERRY89]

Hi Hans,

I some of the data contain formula, in this case i need to paste value..i try this VBA but fail

Sub Spool()
Dim m As Long
Dim b As Long
With Worksheets("DataEntry")
m = .Range("A" & .Rows.Count).End(xlUp).Row
b = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A2:A" & m).Copy Destination:=Worksheets("Sales & Purchase").Range("A2").PasteSpecial(xlPasteValues)
.Range("B2:B" & m).Copy Destination:=Worksheets("Sales & Purchase").Range("C2").PasteSpecial(xlPasteValues)
End With
End Sub

[HansV]

As you have found, you cannot Copy and PasteSpecial in a single instruction.

Code: Select all

Sub Spool()
    Dim m As Long
    With Worksheets("DataEntry")
        m = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A2:A" & m).Copy
        Worksheets("Sales & Purchase").Range("A2").PasteSpecial xlPasteValues
        m = .Range("B" & .Rows.Count).End(xlUp).Row
        .Range("B2:B" & m).Copy
        Worksheets("Sales & Purchase").Range("C2").PasteSpecial xlPasteValues
    End With
End Sub

[JERRY89]

Hi Hans,

Thanks for your guidance. Work successfully

[Doc.AElstein]

Hi Jerry,

If you are only interested in copying the values, then there is another way that we sometimes use…
This way is via the .Value property of a range object.
If you apply this to a range object of a single cell then you will get the cell value,
and
if you apply it to a rectangular area of contiguous cells , ( in other words a typical simple range of cells ), then a field of values , ( like a 2 Dimensional array of values ) is returned.
Conversely, you can also use the .Value property of a range object to assign a single value to a cell, or even assign , all in one go, a 2 Dimensional array of values to a multi cell range , ( a rectangular area of contiguous cells ). The area of cells can , of course, also be a single column as in your case.

We can use .Value completely and easily for your _1. And we can partly use it for your _2.

_1. Simple copy and paste of data values between ranges
This macro shows you what is going on: First we fill an array of the values from one worksheet, then we fill the values in of the range in the other worksheet from that array

Code: Select all

 Sub Copy1() ' http://www.eileenslounge.com/viewtopic.php?p=272191#p272191
Dim m As Long
 Let m = Worksheets("DataEntry").Range("A" & Worksheets("DataEntry").Rows.Count).End(xlUp).Row
Dim arrayInOut() As Variant
 Let arrayInOut() = Worksheets("DataEntry").Range("A2:A" & m & "").Value
 Let Worksheets("Sales & Purchase").Range("B2:B" & m & "").Value = arrayInOut()
End Sub

In the practice, we would “cut out the middle man” , and simply apply the array of values returned on the RHS, directly to the range we want to fill , on the LHS, so that last macro would simplify to

Code: Select all

 Sub Copy1b() '
Dim m As Long
 Let m = Worksheets("DataEntry").Range("A" & Worksheets("DataEntry").Rows.Count).End(xlUp).Row
 Let Worksheets("Sales & Purchase").Range("B2:B" & m & "").Value = Worksheets("DataEntry").Range("A2:A" & m & "").Value
End Sub

_2. Copy Data from Sheet2 Cell A2 until End to sheet 1 Cell D2 (Text Length must 50-Can it capture before a space of the text if it exceed 50 character.)
We can use the same LHS of the code line for this, like:
Let Worksheets("Sheet1").Range("D2:D" & m & "").Value =
To get the array of values on the RHS we can use a slightly advanced technique, that is not really to hard to understand and do. …..
We use the Evaluate(“ “) , which in simple terms, lets us write in the string a formula or expression as we would write it in a worksheet cell , and it will return us the result in a VBA variable , as we would get it in a worksheet cell.
In fact, we can go one step further, and get Evaluate(“ “) to return us similar array type results as we can get in those “CSE Array” worksheet things.

The way I would start is to come up with a worksheet formula that does what you want in the first row… like
=IF(LEN(A2)>50,LEFT(A2,FIND("@",SUBSTITUTE(A2," ","@",LEN(LEFT(A2,50))-LEN(SUBSTITUTE(LEFT(A2,50)," ",""))))-1),A2)
( I am not very good with formulas, there may be a better one, but that will do to help demonstrate what I am trying to explain – In the uploaded workbook I showed how I came up with that formila. )
We then would put that formula into Evaluate(“ “) , with a few modifications:
_a) We replace the single cell reference to extend to the entire range. There are a few ways to do that
_b) If we have any "s inside the formula, that will cause problems in the string inside Evaluate(“ “) , because VBA gets confused. Using a double quote , "" , instead seems to fool VBA into seeing just the single quote we want it to see.
_c) If you have Office version from about 2013, then usually _a) and _b) is all you have to do. For some reason earlier versions appear to sometimes just give us the first result rather than the full array of results. We have a few tricks that we say “coerce” out the array of results. We say “coerce” because it sounds clever and it hides the fact than no one has any idea what’s going on
It does no harm to include the tricks if they are not needed, so for compatibility between versions it is probably best always to include one of them
I use one of the simplest tricks of this form
=If({1}, Here the formula )
The extra trick bit is this bit
=If({1}, )
The rest is the basic formula with the _a) and _b) modifications if/as appropriate

This is the final macro using the discussed techniques. I think it gives the same results as Hans Sub Copy2()

Code: Select all

 Sub Copy2()
Dim m As Long
 Let m = Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Rows.Count).End(xlUp).Row
 Let Worksheets("Sheet1").Range("D2:D" & m & "").Value = Evaluate("=IF({1},IF(LEN(Sheet2!A2:Sheet2!A" & m & ")>50,LEFT(Sheet2!A2:Sheet2!A" & m & ",FIND(""@"",SUBSTITUTE(Sheet2!A2:Sheet2!A" & m & ","" "",""@"",LEN(LEFT(Sheet2!A2:Sheet2!A" & m & ",50))-LEN(SUBSTITUTE(LEFT(Sheet2!A2:Sheet2!A" & m & ",50),"" "",""""))))-1),Sheet2!A2:Sheet2!A" & m & "))")
 End Sub 

Alan

[JERRY89]

Hi Doc.AElstein,

Glad to have your guidance too in this platform. Thanks a lot for let me have more idea in performing my task.