Transfer Specific Cells Data To Another Sheet

Rockey_01

New Member
Joined
Sep 19, 2014
Messages
21
Hi Everyone,
I'm trying to copy some specific cells e.g. (from sheet1) A2,A4,B2,B4,C6,C8 to another sheet.
but all that data should be pasted in a row, (in sheet2) columns A, B, C, D, E, F and on the next empty row.



Manage to find someone online trying to accomplish something similar in year 2004 and i try to follow the code but it
get a run-time error " Run-Time Error '1004': Application-Defined or Object-Defined error " and no follow-up if the code is working.

Can someone help to advice? Thanks

Code:
Sub Get_Data()

    Dim lastrowSheet2 As Long, lastrow As Long
    Dim arr1, arr2, i As Integer
    With Worksheets("Sheet2")
        lastrowSheet2 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    arr1 = Array("B2", "B4", "B6", "D2", "D4", "D6")
    arr2 = Array("A", "B", "C", "D", "E", "F")
    For i = LBound(arr1) To UBound(arr1)
        With Sheets("Sheet1")
             lastrow = Application.Max(3, .Cells(.Rows.Count, Left(arr1(i), 1)).End(xlUp).Row)
             Sheets("Sheet2").Range(arr2(i) & lastrowDB).Resize(lastrow - 2).Value = _
      .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Value
        End With
    Next
    Application.CutCopyMode = False
End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Hi,
quick look at your code, this variable "lastrowDB" has not been declared or intialized. I suspect you need to replace it with
variable "lastrowSheet2" which you have declared & intialized but do not seem to be using.

Hope Helpful

Dave
 
Upvote 0
Hi Rockey_01,

Try this:

Code:
Option Explicit
Sub Macro1()

    Dim lngPasteRow As Long
    Dim varArray1 As Variant, _
        varArray2 As Variant
    Dim intArrayIndex As Integer
    
    On Error Resume Next 'Account for there being no data in 'Sheet2'.
        lngPasteRow = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    
    If lngPasteRow = 0 Then
        lngPasteRow = 2 'Default value if there's no data in 'Sheet2'. Change to suit.
    Else
        lngPasteRow = lngPasteRow + 1
    End If
    
    varArray1 = Array("B2", "B4", "B6", "D2", "D4", "D6")
    varArray2 = Array("A", "B", "C", "D", "E", "F")
    
    Application.ScreenUpdating = False
    
    For intArrayIndex = LBound(varArray1) To UBound(varArray1)
        Sheets("Sheet2").Range(varArray2(intArrayIndex) & lngPasteRow).Value = Sheets("Sheet1").Range(varArray1(intArrayIndex)).Value
    Next intArrayIndex

    Application.ScreenUpdating = True

End Sub

HTH

Robert
 
Upvote 0
Hi Trebor76,

This is just wonderful. Is there a way I can clear the data automatically for the next entry as well when I click the submit button? Thanks!!!
 
Upvote 0
I take it you mean to clear the data from Sheet1 after it gets populated to Sheet2?

If so, this will do the job:

Code:
Option Explicit
Sub Macro1()

    Dim lngPasteRow As Long
    Dim varArray1 As Variant, _
        varArray2 As Variant
    Dim intArrayIndex As Integer
    
    On Error Resume Next 'Account for there being no data in 'Sheet2'.
        lngPasteRow = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    
    If lngPasteRow = 0 Then
        lngPasteRow = 2 'Default value if there's no data in 'Sheet2'. Change to suit.
    Else
        lngPasteRow = lngPasteRow + 1
    End If
    
    varArray1 = Array("B2", "B4", "B6", "D2", "D4", "D6")
    varArray2 = Array("A", "B", "C", "D", "E", "F")
    
    Application.ScreenUpdating = False
    
    For intArrayIndex = LBound(varArray1) To UBound(varArray1)
        With Sheets("Sheet1").Range(varArray1(intArrayIndex))
            Sheets("Sheet2").Range(varArray2(intArrayIndex) & lngPasteRow).Value = .Value
            .ClearContents
        End With
    Next intArrayIndex

    Application.ScreenUpdating = True

End Sub

Regards,

Robert
 
Upvote 0

Forum statistics

Threads
1,216,410
Messages
6,130,423
Members
449,581
Latest member
econtent2

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