Autocopy from one cell to another cell in a spreadsheet

B

broc_ariums2003

I need help creating a macro to copy from a cell in sheet1 to a cell in
sheet2. Though when it pastes I can't have it fill the same cell over
again I need it to paste it in the next cell down from it.


Example:


Sheet1 -> Sheet2


B12 -> B2 and after the person clicks the macro the next would move
down to B3, B4, B5...
D12 -> C2, C3, C4... so on and so forth
I5 -> A2
I17 -> E2
G12 -> D2
I22 -> F2
I27 -> G2

I just can't seem to figure this out because I have almost 0 knowledge
of VB. Can someone help me with a step by step?
 
D

Dave Peterson

One way:

Option Explicit
'B12 -> B2
'D12 -> C2
'I5 -> A2
'I17 -> E2
'G12 -> D2
'I22 -> F2
'I27 -> G2
Sub testme()

Dim fWks As Worksheet
Dim tWks As Worksheet

Dim fAddr As Variant
Dim tCol As Variant

Dim cCtr As Long
Dim oRow As Long

fAddr = Array("b12", "d12", "i5", "i17", "g12", "i22", "i27")
tCol = Array("b", "c", "a", "e", "d", "f", "g")

If UBound(fAddr) <> UBound(tCol) Then
MsgBox "design error--not same number of columns/cells)"
End If

Set fWks = Worksheets("sheet1")
Set tWks = Worksheets("Sheet2")

With tWks
oRow = .Cells(.Rows.Count, tCol(LBound(tCol))).End(xlUp).Row + 1
End With

With fWks
If IsEmpty(.Range(fAddr(LBound(fAddr)))) Then
MsgBox "Please enter data in: " & fAddr(LBound(fAddr))
Exit Sub
End If

For cCtr = LBound(fAddr) To UBound(fAddr)
tWks.Cells(oRow, tCol(cCtr)).Value = .Range(fAddr(cCtr)).Value
.Range(fAddr(cCtr)).ClearContents '???
Next cCtr
End With

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top