VBA for copying Active Cell to another worksheet

Okay, I'm looking to see if there's a vba formula that would allow a macro to copy 3 cell values (example B2, C2 and D2) from active cell range ("A1") and paste into another worksheet (inside the same workbook) cell A7/A8/A9 then print the newly structured data, and loop to the next cell and start over again. Just that I never know how many will be on the report so I was originally telling it to "Do While IsEmpty(ActiveCell.Range("A1")) = False" lol but nothing is working so figured i'd start from scratch and ask.

Not sure which direction to go on this one, and just looking to see if anyone knows, any help is greatly appreciated.

Thank you
EETEST.xlsb
NYANBCNY32Asked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
Subodh Tiwari (Neeraj)Connect With a Mentor Excel & VBA ExpertCommented:
Does this work for you?

Sub CompanyAddTransfer()
Dim sws As Worksheet, dws As Worksheet
Dim x
Dim i As Long, lr As Long
Set sws = Sheets("AddressCard")
Set dws = Sheets("Data")
lr = dws.Cells(Rows.Count, 1).End(xlUp).Row
If lr < 2 Then
   MsgBox "There is no Data on AddressCard Sheet.", vbCritical, "Data Not Found!"
   Exit Sub
End If
x = sws.Range("A1").CurrentRegion.Value
For i = 2 To UBound(x, 1)
   With dws
      .Range("A7").Value = x(i, 1)
      .Range("A8").Value = x(i, 2)
      .Range("A9").Value = x(i, 3) & ", " & x(i, 4) & " " & x(i, 5)
      .PrintOut
   End With
Next i
End Sub

Open in new window

0
 
Roy CoxGroup Finance ManagerCommented:
Not sure what you mean. You can use something like this to copy to the bottom of the list in AddressCard

 Range(ActiveCell, ActiveCell.End(xlDown)).Copy
    With Sheets("AddressCard")
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                                                      False, Transpose:=True
    End With

Open in new window


If you want to get the address from AddressCard then add a column on the left  for a company id number and use VLOOKUP
0
 
Roy CoxGroup Finance ManagerCommented:
If you want to copy the address from the list here's a way with VLOOKUP. If this is what you mean then it can be adapted to not use empty cells, e.g if no Zip exists.
EETEST.xlsb
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
NYANBCNY32Author Commented:
The macro i'm looking to do would do the following steps:

1.) Copy/Transfer on a line by line basis Company Name/Address from the worksheets("AddressCard") to the designated cells in worksheets("Data") A7 = Company Name, A8 = Company Address and A9 = City State Zip. (The City/State/Zip i would Trim & Concatenate into one cell into column C on AddressCard before I ran the macro )

2.) Once it copies/transfers the data it would then print worksheets("Data").

3.) Move on to the next row and loop the whole process once again.

This was originally the coding I started to toy with, but it's really just whatever I've been able to find to put it all together so I know it probably looks horrible lol I know it does because it doesn't work.

Sub CompanyAddTransfer()
'
' CompanyAddTransferMacro
'
Do While IsEmpty(ActiveCell.Range("A1")) = False

Dim LName As Integer
Dim Add1 As Integer
Dim CSZ As Integer
Dim LtrName As Integer
Dim LtrAddl As Integer
Dim LtrCSZ As Integer



LName = ActiveCell.Range("A1").Value
Addl = ActiveCell.Range("B1").Value
CSZ = ActiveCell.Range("C1").Value
LtrName = Worksheets("Sheet1").Range("A7")
LtrAddl = Worksheets("Sheet1").Range("A8")
LtrCSZ = Worksheets("Sheet1").Range("A9")

LtrName = LName
LtrAddl = Addl
LtrCSZ = CSZ

Worksheets("Data").PrintOut

Loop
'
End Sub
0
 
NYANBCNY32Author Commented:
That was exactly what I needed.  Thank you.
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome. Glad to help.
0
All Courses

From novice to tech pro — start learning today.