Macro for copying individual cells in a column and pasting

[zeebo12]

Hi,

I'm at a dead end with a macro i've been putting together primarily with hint and code i've picked up of this forum. Essentially i'm putting together a macro to automate the analysis of a report, which will then feed into a mailmerge for communication out to 800 or so contacts.

I am breaking down a spreadsheet for branch managers, based on their branch number - then saving the information in a separate file for the mail merge.

The worksheet i have assembled (Master) feeds off another sheet (Data) and is driven by lookups, utilising the branch code.

The branch codes are stored in a single column (Column A) (800 entries) on a separate sheet (BranchList). For the sake of the macro i copy a branch code and enter it into the lookup cell (G1) on my Master sheet, then save a copy of the master sheet as the branch number, before closing that copied sheet.

So far i have got everything sorted - except how to automate the
repetition of copying of the individual branch codes across from the A cells on BranchList sheet to G1 on the Master sheet.

Code so far is:

Sub TrailOne()
Workbooks.Open Filename:= _
"K:\ATO and Training\Driver Comp\Idling\Idling Reports\MailMerge\we1\BranchList.xls"
Range("A2").Select
Selection.Copy
Windows("444.xls").Activate
Range("G1").Select
ActiveSheet.Paste
Application.Goto Reference:="R1C1"
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveAs Filename:="\\G\Transport\ATO and Training\Driver Compl\Idling\Idling Reports\MailMerge\we1\" & Range("G1").Value & ".xls"
ActiveWorkbook.Close
End Sub

Any help would be greatly appreciated, and save me having to repeat the code manually 800 times!

Thanks.

 

[JasonMac]

I'm not exactly sure but it looks like you just want to loop it until there is nothing more in column A. Maybe something like
<CODE>
Dim i as Integer
Dim Lastrow As Integer
With ActiveSheet
LastRow = .Cells(.Rows.count, "A").End(xlUp).Row
End With

For i = 0 To LastRow
Range("A" & i).Select
Selection.Copy
...Put rest of your code here...
Next i
<\CODE>

 

[zeebo12]

JasonMac, thanks for the reply.

I am getting a scripting error (1004), specifically focused on the following code:

Range("A" & i).Select

I've tried variations on it without much success, any further guidance would be a massive help

 

[JasonMac]

Sorry, make i = 1 in the for loop, there is no cell A0.
Try this it should work now!

 

[njimack]

Note that you don't have to select cells to perform actions on them, e.g.

Range("A2").Select
Selection.Copy
Windows("444.xls").Activate
Range("G1").Select
ActiveSheet.Paste

could be achieved by:

Range("A2").Copy Workbooks("444.xls").Sheets("Sheet1").Range("G1")

or

Workbooks("444.xls").Sheets("Sheet1").Range("G1").Value = ThisWorkbook.Sheets("Sheet1").Range("A2")