VBA to paste only certain values of cell from one sheet to another.

Excelkids

New Member
Joined
Oct 15, 2014
Messages
4
Hello,

Can some one help me with the below code, what I am looking for is, from sheet "Form" certain values of cells mentioned in 2 sets of Array.
1st set of Array should get copied to sheet "Tracker" C3 onward and second set of array from next cell after the 1set of array ends say EF3 onwards.

whereas now first sett is its pasting from A3 and second from A4. Please let me know in case of any question.

Following is the code which I am using now:

Sub AddEntry()

Dim LR AsLong, i AsLong, cls
Dim LR2 AsLong, j AsLong, cls2

cls = Array("C2", "C3", "G2", "G3", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13", "A17", "C17", "D17", "F17", "G17", "H17", "A18", "C18", "D18", "F18", "G18", "H18", "A19", "C19", "D19", "F19", "G19", "H19", "A20", "C20", "D20", "F20", "G20", "H20", "A21", "C21", "D21", "F21", "G21", "H21", "A25", "B25", "C25", "D25", "E25", "F25", "G25", "H25", "A26", "B26", "C26", "D26", "E26", "F26", "G26", "H26", "A27", "B27", "C27", "D27", "E27", "F27", "G27", "H27", "A28", "B28", "C28", "D28", "E28", "F28", "G28", "H28", "A32", "C32", "E32", "G32", "H32", "A33", "C33", "E33", "G33", "H33", "A34", "C34", "E34", "G34", "H34", "A35", "C35", "E35", "G35", "H35", "A39", "D39", "F39", "A40", "D40", "F40", "A41", "D41", "F41", "A45", "C45", "E45", "G45", "A46", "C46", "E46", "G46", "A47", "C47", "E47", "G47", "D51", "D52", "D53", "D54", "D55", "D56", "D57", "D58", "D59", "D60", "D61", "D62", "D63", "D64", "D65", "D66", "D67")
With Sheets("Tracker")
LR = WorksheetFunction.Max(3, .Range("C" & Rows.Count).End(xlUp).Row + 1)
For i = LBound(cls) ToUBound(cls)
.Cells(LR, i + 1).Value = Sheets("Form").Range(cls(i)).Value
Next i
EndWith

cls2 = Array("E51", "E52", "E53", "E54", "E55", "E56", "E57", "E58", "G59", "E60", "E61", "E62", "G63", "E64", "E65", "E66", "E67", "C70", "D70", "E70", "F70", "G70", "H70", "C71", "E71", "G71", "C72", "E72", "G72", "C73", "E73", "G73", "C74", "E74", "G74", "C75", "E75", "G75", "C76", "E76", "G76", "C77", "E77", "G77", "C78", "E78", "G78", "C79", "E79", "G79", "C82", "D82", "E82", "F82", "G82", "H82", "C83", "E83", "G83", "C84", "E84", "G84", "B88", "B89", "B90", "B91", "C88", "C89", "C90", "C91", "D88", "D89", "D90", "D91", "E88", "E89", "E90", "E91", "F88", "F89", "F90", "F91", "G88", "G89", "G90", "G91", "H88", "H89", "H90", "H91")
With Sheets("Tracker")
LR2 = WorksheetFunction.Max(3, .Range("EW" & Rows.Count).End(xlUp).Row + 1)
For j = LBound(cls2) ToUBound(cls2)
.Cells(LR, j + 1).Value = Sheets("Form").Range(cls2(j)).Value
Next j
EndWith
End sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Hi,
welcome to forum.

not fully tested but see if these changes to your code now do what you want

Code:
Option Base 1
Sub AddEntry()
    
    Dim LR As Long, i As Long
    Dim cls As Variant, cls2 As Variant
    Dim arr() As Variant, Joinarr As Variant
    
    cls = Array("C2", "C3", "G2", "G3", "C5", "C6", "C7", "C8", "C9", "C10", "C11", _
    "C12", "C13", "A17", "C17", "D17", "F17", "G17", "H17", "A18", "C18", _
    "D18", "F18", "G18", "H18", "A19", "C19", "D19", "F19", "G19", "H19", _
    "A20", "C20", "D20", "F20", "G20", "H20", "A21", "C21", "D21", "F21", _
    "G21", "H21", "A25", "B25", "C25", "D25", "E25", "F25", "G25", "H25", _
    "A26", "B26", "C26", "D26", "E26", "F26", "G26", "H26", "A27", "B27", _
    "C27", "D27", "E27", "F27", "G27", "H27", "A28", "B28", "C28", "D28", _
    "E28", "F28", "G28", "H28", "A32", "C32", "E32", "G32", "H32", "A33", _
    "C33", "E33", "G33", "H33", "A34", "C34", "E34", "G34", "H34", "A35", _
    "C35", "E35", "G35", "H35", "A39", "D39", "F39", "A40", "D40", "F40", _
    "A41", "D41", "F41", "A45", "C45", "E45", "G45", "A46", "C46", "E46", _
    "G46", "A47", "C47", "E47", "G47", "D51", "D52", "D53", "D54", "D55", _
    "D56", "D57", "D58", "D59", "D60", "D61", "D62", "D63", "D64", "D65", "D66", "D67")
    
    
    cls2 = Array("E51", "E52", "E53", "E54", "E55", "E56", "E57", "E58", "G59", "E60", "E61", _
    "E62", "G63", "E64", "E65", "E66", "E67", "C70", "D70", "E70", "F70", "G70", _
    "H70", "C71", "E71", "G71", "C72", "E72", "G72", "C73", "E73", "G73", "C74", _
    "E74", "G74", "C75", "E75", "G75", "C76", "E76", "G76", "C77", "E77", "G77", _
    "C78", "E78", "G78", "C79", "E79", "G79", "C82", "D82", "E82", "F82", "G82", _
    "H82", "C83", "E83", "G83", "C84", "E84", "G84", "B88", "B89", "B90", "B91", _
    "C88", "C89", "C90", "C91", "D88", "D89", "D90", "D91", "E88", "E89", "E90", _
    "E91", "F88", "F89", "F90", "F91", "G88", "G89", "G90", "G91", "H88", "H89", "H90", "H91")
    
    Joinarr = Split(Join(cls, Chr(1)) & Chr(1) & Join(cls2, Chr(1)), Chr(1))
    
    
    ReDim arr(1 To UBound(Joinarr))
    
    
    For i = 1 To UBound(arr)
        arr(i) = ThisWorkbook.Sheets("Form").Range(Joinarr(i)).Value
    Next i
        
    With ThisWorkbook.Sheets("Tracker")
        LR = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
        If LR < 3 Then LR = 3
        .Cells(LR, 3).Resize(, UBound(arr)).Value = arr
    End With
        
End Sub

Note Option Base 1 statement which MUST sit at very TOP of your module OUTSIDE of any procedure.

Hope Helpful

Dave
 
Upvote 0

Forum statistics

Threads
1,214,518
Messages
6,119,985
Members
448,935
Latest member
ijat

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top