• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to copy data if Range of that data given a cells using Macro

A

Akash kothari

Member
How can we copy data from a range if Data's start cell and End cell is mentioned in 2 different cell. which is not part of that data.

Example:
Within cell A1 start range of data is given as D1
and in cell B1 End range of data is given as H20
and copy this data and paste in sheet2

so values in A1 and B1 is working as reference to data range which can be changed according to need to copy data. and paste in another sheet.

Thank you
 
Try this code
Code: 
Sub Test()
    Dim strA As String, strB As String
    strA = Sheet1.Range("A1").Value
    strB = Sheet1.Range("B1").Value
   
    Sheet1.Range(strA & ":" & strB).Copy Sheet2.Range("A1")
End Sub
 
Hi Yasserkhalil,

Thank you for your response,

Is it possible in above code to copy Individual column and not the complete data?

Like if in Cell A1 data start range is given as D1 and in cell B1 end date is H20.
Is it possible to skip data in column E, G and copy data from all other column D,F and H data?

Thank you
 
How could it be copy F and no reference in A1 neither B1
in A1 : the string D1
in B1 : the string H20
skipping would be all the columns between ..!!
 
I think I did not explained it properly
value given in cell A1 and B1 (D1 and H20) is range like (D1:H20) so it will copy complete data.
Now what I am looking is starting from cell D1:20 it should copy then skip next column E completely and copy the F1 to F20 and so on till H20

Thank you
 
Suppose range("A1")= D1
and range("B1")=H20

Try this code
Code: 
Sub Test()
    Dim strA As String, strB As String
    Dim startRow As Long, endRow As Long
    Dim startCol As Long, endCol As Long

    strA = Sheet1.Range("A1").Value
    strB = Sheet1.Range("B1").Value

    startRow = CLng(AlphaNum(strA, 1))
    endRow = CLng(AlphaNum(strB, 1))

    startCol = ColumnLetterToNumber(AlphaNum(strA, 0))
    endCol = ColumnLetterToNumber(AlphaNum(strB, 0))
    With Sheet1
        .Range(.Cells(startRow, startCol), .Cells(endRow, startCol)).Copy Sheet2.Range("A1")
        .Range(.Cells(startRow, startCol + 2), .Cells(endRow, endCol)).Copy Sheet2.Range("B1")
    End With
End Sub

Function AlphaNum(txt As String, Optional numOnly As Boolean = True) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = IIf(numOnly = True, "\D+", "-?\d+(\.\d+)?")
        .Global = True
        AlphaNum = .Replace(txt, "")
    End With
End Function

Public Function ColumnLetterToNumber(InputCharColumn As String) As Long
    Dim S As String
    Dim C1 As String
    Dim C2 As String
    Dim ColRef1 As Integer
    S = UCase(InputCharColumn)

    If Len(S) = 1 Then
        ColumnLetterToNumber = Asc(S) - 64
    ElseIf Len(S) = 2 Then
        C1 = Left$(S, 1)
        ColRef1 = (Asc(C1) - 64) * 26
        C2 = Right$(S, 1)
        ColumnLetterToNumber = ColRef1 + (Asc(C2) - 64)
    End If
End Function
 
Hello,

i just need to copy data from for example; E6:H6 , E7:H7 e.g. how should i prepare my code..
i was using array formulas but there were 2430 cells and in the end i got procedure too large error..

Thanks!
 
YasserKhalil said:
Hi memot
can you attach a sample file?
Click to expand...

Hi! Thank you very much for your response. I attached the sample file. Here i have added 2 data sheets and main sheet is for the history. When i run the macro, it must copy the numbers to the history but only for the spesific line. For instance, second line of the table x will be written to the 7nd cell at the history.

Thank you very much!
 

Attachments

  • Example macro.xlsx
    11.6 KB · Views: 0
Your request is no totally clear for me.. You need to copy all the table in Sheets("Data") to Sheets("History) in the first empty row?
 
YasserKhalil said:
Your request is no totally clear for me.. You need to copy all the table in Sheets("Data") to Sheets("History) in the first empty row?
Click to expand...
Exactly, in fact my real data file is including 2500 cells and every line has 6 columns. So it will copy them in order to the first line of "history".
 
Try this code
Code: 
Sub CopyByArray()
    Dim LR As Long, ArrSize As Long, I As Long, J As Long, P As Long
    Dim Arr, ArrOut
    LR = Sheets("Data").Cells(Rows.Count, "E").End(3).Row

    Arr = Sheets("Data").Range("E6:J" & LR).Value
    ArrSize = UBound(Arr, 1) * UBound(Arr, 2)
    ReDim ArrOut(ArrSize)
    For I = 1 To UBound(Arr, 1)
        For J = 1 To UBound(Arr, 2)
            ArrOut(P) = Arr(I, J)
            P = P + 1
        Next J
        J = 1
    Next I

    With Sheets("History")
        .Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1).Resize(1, UBound(ArrOut)).Value = ArrOut
    End With
End Sub
 
YasserKhalil said:
Try this code
Code: 
Sub CopyByArray()
    Dim LR As Long, ArrSize As Long, I As Long, J As Long, P As Long
    Dim Arr, ArrOut
    LR = Sheets("Data").Cells(Rows.Count, "E").End(3).Row

    Arr = Sheets("Data").Range("E6:J" & LR).Value
    ArrSize = UBound(Arr, 1) * UBound(Arr, 2)
    ReDim ArrOut(ArrSize)
    For I = 1 To UBound(Arr, 1)
        For J = 1 To UBound(Arr, 2)
            ArrOut(P) = Arr(I, J)
            P = P + 1
        Next J
        J = 1
    Next I

    With Sheets("History")
        .Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1).Resize(1, UBound(ArrOut)).Value = ArrOut
    End With
End Sub
Click to expand...

Thank you very much, it looks like working great! Tomorrow i will try to adapt this to real data. Btw can you just add comments to the steps so i can understand the reasoning?

For ex:
'Here i am creating the loop for macro to use the last line from table" etc.
For I = 1 To UBound(Arr, 1)
For J = 1 To UBound(Arr, 2)
ArrOut(P) = Arr(I, J)
P = P + 1
Next J
J = 1
Next I
Best,
 
This is loop to convert two dimensional array to one dimensional array as the table is considered as two dimensional array and the desired result would be in one row so it is considered one dimensional array
The nested loops to get the values of the table array and put values in new array named "Arrout"

You can debug the code by pressing F8 and follow the code line by line (Follow Locals window)
 
Hi Yasserkhalil,

Sorry for delayed response,

Please see in the attached file 1 sheet is the data and 2nd sheet is what output I am looking for.
Picking columns D, G, J and M, . From the range defined in cell A1 and B1.

Thank you
Akash
 

Attachments

  • asdsd.xlsm
    17.9 KB · Views: 0
Try this code
Code: 
Sub Test()
    Dim strA As String, strB As String
    Dim startRow As Long, endRow As Long
    Dim startCol As Long, endCol As Long
    Dim I As Long, LC As Long
   
    strA = Sheet1.Range("A1").Value
    strB = Sheet1.Range("B1").Value

    startRow = CLng(AlphaNum(strA, 1))
    endRow = CLng(AlphaNum(strB, 1))

    startCol = ColumnLetterToNumber(AlphaNum(strA, 0))
    endCol = ColumnLetterToNumber(AlphaNum(strB, 0))
   
    For I = startCol To endCol Step 3
    With Sheet1
        .Range(.Cells(startRow, I), .Cells(endRow, I)).Copy Sheet2.Cells(1, LC + 1)
        LC = LC + 1
    End With
    Next I
End Sub

Function AlphaNum(txt As String, Optional numOnly As Boolean = True) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = IIf(numOnly = True, "\D+", "-?\d+(\.\d+)?")
        .Global = True
        AlphaNum = .Replace(txt, "")
    End With
End Function

Public Function ColumnLetterToNumber(InputCharColumn As String) As Long
    Dim S As String
    Dim C1 As String
    Dim C2 As String
    Dim ColRef1 As Integer
    S = UCase(InputCharColumn)

    If Len(S) = 1 Then
        ColumnLetterToNumber = Asc(S) - 64
    ElseIf Len(S) = 2 Then
        C1 = Left$(S, 1)
        ColRef1 = (Asc(C1) - 64) * 26
        C2 = Right$(S, 1)
        ColumnLetterToNumber = ColRef1 + (Asc(C2) - 64)
    End If
End Function
 
Hi !

Procedure ColumnLetterToNumber is not necessary
'cause of Range property Column !​
Akash kothari said:
Picking columns D, G, J and M.
From the range defined in cell A1 and B1.​
Click to expand...
For a simple data copy, code needs no more than 20 lines (in fact half !) :​
Code: 
Sub Demo()
With Sheet1.Range(Sheet1.[A1].Value).CurrentRegion
    VA = Application.Index(.Value, Evaluate("ROW(1:" & .Rows.Count & ")"), [{1,4,7,10}])
End With
 
With Sheet2
    .UsedRange.Clear
    .Cells(1).Resize(UBound(VA), UBound(VA, 2)).Value = VA
End With
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
 
May be this is a sample file and it may be different from the original file ..
Let OP determine
In fact I liked your simple and faster code and it would be very useful in many cases. Thanks for sharing it
 

Index and ROW are just Excel worksheet functions :
so better is to think Excel before VBA for an efficient code !

Read also VBA inner help of powerful Evaluate methode …

But without Excel functions, respecting TBTO rule,
a beginner should code with a few lines as well :​
Code: 
Sub DemoBeginner()
                       COL = Array(1, 4, 7, 10)
Application.ScreenUpdating = False
Sheet2.UsedRange.Clear

With Sheet1.Range(Sheet1.Range("A1").Value, Sheet1.Range("B1").Value)
    For C& = 0 To UBound(COL)
        .Columns(COL(C)).Copy Sheet2.Cells(C + 1)
    Next
End With
End Sub
 
Code: 
Sub DemoVeryBeginner()
Application.ScreenUpdating = False
Sheet2.UsedRange.Clear

With Sheet1.Range(Sheet1.Range("A1").Value, Sheet1.Range("B1").Value)
     .Columns(1).Copy Sheet2.Cells(1)
     .Columns(4).Copy Sheet2.Cells(2)
     .Columns(7).Copy Sheet2.Cells(3)
    .Columns(10).Copy Sheet2.Cells(4)
End With
End Sub
 
YasserKhalil said:
This is loop to convert two dimensional array to one dimensional array as the table is considered as two dimensional array and the desired result would be in one row so it is considered one dimensional array
The nested loops to get the values of the table array and put values in new array named "Arrout"

You can debug the code by pressing F8 and follow the code line by line (Follow Locals window)
Click to expand...

Hello YasserKhalil, it's me again :)
Here is a new example file, could you please help me to create a macro to copy data from table to "A" and "B" sheets? In the file you could understand easily what i meant..

When i run the macro, it should copy the data from DATE01 - A column and paste transpose to DATE 01 in "A" sheet.

Thank you!
 

Attachments

  • Example macro (1).xlsx
    10.8 KB · Views: 2
You must log in or register to reply here.
Back
Top