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

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
7,309
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,945
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,945

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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,487
Messages
5,831,980
Members
430,100
Latest member
namhnz

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
Top