VBA to Copy Data and Paste On a Loop

[Jess709]

I am in the early stages of learning VBA and Macros and am in need of assistance.

I have a spreadsheet with 2 tabs of data. First tab named "acctinfo" has 2 columns of data. Column A is for the account numbers and column B is for job descriptions. Second tab named "jobdescriptions" just has one column of data, A. At the present time there are 214 rows, but depending on the data there may be more rows than that.

I need to copy a set of data from the 2nd tab, named "JobDescriptions" and paste it into the 1st tab named "AcctInfo" In the JobDescriptions tab I want the macro to copy the data starting with the first cell under the column heading (i.e B2), until it reaches a blank cell. After the data is copied I want it to be pasted into the 1st tab starting in cell B2. I then want it to continue pasting that same set of data until the last cell that has a value column A (example A2:A214).

The objective is to provide our programming department with a spreadsheet of job descriptions for 49 accounts and each account has to have a row for every job description. For example, if there are 213 job descriptions then the spreadsheet will have 213 rows for account # 64104408, 213 rows for account # 6414409 and so on.

Here is a sample of what the final output would look like, shortened.

Thank you so much for any help you can provide!!

Acct #	Job Description
64104408	ACAD AFF STAFF ADM__UNCLASSIFIED
64104408	ACADEMIC AFFAIRS OF__UNCLASSIFIED
64104408	ACCOUNT CLERK__UNCLASSIFIED
64104408	ACCOUNTANT__UNCLASSIFIED
64104408	ACCOUNTANT 1__CLASSIFIED
64104408	ACCOUNTANT 2__CLASSIFIED
64104408	ACCOUNTANT 3__CLASSIFIED

<tbody>
</tbody>

 

[Jess709]

I was able to get the code fixed, here it is in case anyone else wants to see:

Sub CopyJobDesc()
'
' CopyJobDesc Macro
 
 
    Sheets("JobDescriptions").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("AcctInfo").Select
    Range("B2").Select
   
   
    Range("B" & Cells.Rows.Count).End(xlUp).Select
    Do Until IsEmpty(ActiveCell.Offset(1, -1))
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Range("B" & Cells.Rows.Count).End(xlUp).Select
Loop
 
End Sub