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
 

Some videos you may like

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,083
Office Version
  1. 2019
Platform
  1. Windows
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
 

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,676
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
 

Rockey_01

New Member
Joined
Sep 19, 2014
Messages
21
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!!!
 

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,676

ADVERTISEMENT

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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,911
Messages
5,525,588
Members
409,652
Latest member
strangelyangely

This Week's Hot Topics

Top