Coding help please - Looping through drop down lists and copy/pasting contents into new workbook, saving

davidandrewlawrence

New Member
Joined
Feb 19, 2008
Messages
3
Hello,
My first post, please be nice
My coding skills aren't great, but otherwise very well skilled in Excel.

Hoping somebody can help, I'm stumped.

I have a workbook with tables and charts that are populated from another worksheet (in the same workbook) using lookups.
There is a dropdown box which list some geographical areas and upon selecting a new area the worksheet re-populates.
Standard stuff.

My issue is I want to be able to loop through each area , each time copying the contents of the worksheet, open a blank template, paste the data, save it as the area's name, close the document (it needs to be emailed as attachment).
Repeat until the end of the list.
I've made a start, but I'm getting a runtime error 9 message and I can't see that the issue is. I know the code works to a point, but can't check after. The blank workbook will open but then it falls over.

Grateful for any help, be it tweaks or have my code ripped apart and done differently! Cheers.

My code reads:

Sub LoopClusterAndSave()

'set range
Dim rng As Range
'this is where my dropdown list populates from
Set rng = Sheets("Cluster list").Range("A1:A24")
'Select the first cluster in the drop down list:
For Each cell In rng.Cells
Sheets("PickACluster").Range("A1").Value = cell.Value 'PickACluster is the name of the worksheet with my data

'Select the entire worksheet to copy
Sheets("PickACluster").Select
Cells.Select
'Copy it
Selection.Copy

'Open the blank template document where we want to paste this data:
Workbooks.Open Filename:="\\netapp04-cifs\lcc017\ELSSI\SEMH CLUSTER DATA\City Wide Cluster Reporting and Recording\Central Collation & Analysis Tools\BlankChartTemplate.xlsx"

'Activate this window
Windows("BlankChartTemplate.xlsx").Activate

'Select the top left cell where I will paste all data
ActiveWorkbook.Sheets(1).Range("A1").Select

'Paste the clipboard
ActiveWorkbook.Sheets(1).Paste
Next cell

End Sub
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

PatOBrien198

Board Regular
Joined
Sep 13, 2017
Messages
236
which line is giving you the error?

is it the line below "'Ativate this window"

Have you recorded a macro of you doing this to get sample syntax?
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,920
Office Version
  1. 2019
Platform
  1. Windows
Hi welcome to forum

Untested but see if update to your code helps

Rich (BB code):
Sub LoopClusterAndSave()
    Dim rng As Range, cell As Range
    Dim wsPicACluster As Worksheet
    Dim wbTemplate As Workbook
    Dim FilePath As String, FileName As String
    
    'PickACluster is the name of the worksheet with my data
    Set wsPicACluster = ThisWorkbook.Worksheets("PickACluster")
    
    FilePath = "\\netapp04-cifs\lcc017\ELSSI\SEMH CLUSTER DATA\City Wide Cluster Reporting and Recording\Central Collation & Analysis Tools\"
    FileName = "BlankChartTemplate.xlsx"
    
'this is where my dropdown list populates from
    Set rng = ThisWorkbook.Worksheets("Cluster list").Range("A1:A24")
'Select the first cluster in the drop down list:
    For Each cell In rng.Cells
    
        wsPicACluster.Range("A1").Value = cell.Value
    
'Open the blank template document where we want to paste this data:
    Set wbTemplate = Workbooks.Open(FileName:=FilePath & FileName, ReadOnly:=False)
    
        With wbTemplate
            wsPicACluster.UsedRange.Copy .Sheets(1).Range("A1")
            .SaveAs "C:\myDocuments\MyFolder\" & cell.Value & ".xlsx", 51
            .Close False
        End With
        Set wbTemplate = Nothing
    Next cell


End Sub

You will need to change the values shown in red as required.

Dave
 

davidandrewlawrence

New Member
Joined
Feb 19, 2008
Messages
3
Hi welcome to forum

Untested but see if update to your code helps

Rich (BB code):
Sub LoopClusterAndSave()
    Dim rng As Range, cell As Range
    Dim wsPicACluster As Worksheet
    Dim wbTemplate As Workbook
    Dim FilePath As String, FileName As String
    
    'PickACluster is the name of the worksheet with my data
    Set wsPicACluster = ThisWorkbook.Worksheets("PickACluster")
    
    FilePath = "\\netapp04-cifs\lcc017\ELSSI\SEMH CLUSTER DATA\City Wide Cluster Reporting and Recording\Central Collation & Analysis Tools\"
    FileName = "BlankChartTemplate.xlsx"
    
'this is where my dropdown list populates from
    Set rng = ThisWorkbook.Worksheets("Cluster list").Range("A1:A24")
'Select the first cluster in the drop down list:
    For Each cell In rng.Cells
    
        wsPicACluster.Range("A1").Value = cell.Value
    
'Open the blank template document where we want to paste this data:
    Set wbTemplate = Workbooks.Open(FileName:=FilePath & FileName, ReadOnly:=False)
    
        With wbTemplate
            wsPicACluster.UsedRange.Copy .Sheets(1).Range("A1")
            .SaveAs "C:\myDocuments\MyFolder\" & cell.Value & ".xlsx", 51
            .Close False
        End With
        Set wbTemplate = Nothing
    Next cell


End Sub

You will need to change the values shown in red as required.

Dave

Hi,

Dave, many thanks for your help.
I've tried your suggestion. I changed the filepath to my documents to keep things simpler.

I'm still having issues, I can't work out why.
When I tried your code, the workbook seemed to be between filenames. It was renamed as per your code but the save hasn't finished as the file doesn't exist on the network.
It stops running on the line shown below Tried for ages to fix it :(

'Sub LoopClusterAndSave()
' Dim rng As Range, cell As Range
' Dim wsPicACluster As Worksheet
' Dim wbTemplate As Workbook
' Dim FilePath As String, FileName As String
'
' 'PickACluster is the name of the worksheet with my data
' Set wsPicACluster = ThisWorkbook.Worksheets("PickACluster")
'
' FilePath = "C:\Users\00822593\Documents\Reports to send"
' FileName = "BlankChartTemplate.xlsx"
'
''this is where my dropdown list populates from
' Set rng = ThisWorkbook.Worksheets("Cluster list").Range("A1:A24")
''Select the first cluster in the drop down list:
' For Each cell In rng.Cells
'
' wsPicACluster.Range("A1").Value = cell.Value
'
''Open the blank template document where we want to paste this data:
' Set wbTemplate = Workbooks.Open(FileName:=FilePath & FileName, ReadOnly:=False) ' << STOPS RUNNING ON THIS LINE WITH ERROR "RUNTIME ERROR '1004'"
'
' With wbTemplate
' wsPicACluster.UsedRange.Copy .Sheets(1).Range("A1")
' .SaveAs "C:\Users\00822593\Documents\Reports to send" & cell.Value & ".xlsx", 51
' .Close False
' End With
' Set wbTemplate = Nothing
' Next cell
'
'
'End Sub
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,920
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

try this update

Code:
Sub LoopClusterAndSave()
    Dim rng As Range, cell As Range
    Dim wsPicACluster As Worksheet
    Dim wbTemplate As Workbook
    Dim FilePath As String, FileName As String
'
' 'PickACluster is the name of the worksheet with my data
    Set wsPicACluster = ThisWorkbook.Worksheets("PickACluster")
'
    FilePath = "C:\Users\00822593\Documents\Reports to send\"
    FileName = "BlankChartTemplate.xlsx"
    
    If Dir(FilePath & FileName, vbDirectory) <> vbNullString Then
        
''this is where my dropdown list populates from
        Set rng = ThisWorkbook.Worksheets("Cluster list").Range("A1:A24")
''Select the first cluster in the drop down list:
        For Each cell In rng.Cells
'
            wsPicACluster.Range("A1").Value = cell.Value
'
''Open the blank template document where we want to paste this data:
            Set wbTemplate = Workbooks.Open(FileName:=FilePath & FileName, ReadOnly:=True)
'
            With wbTemplate
                wsPicACluster.UsedRange.Copy .Sheets(1).Range("A1")
                .SaveAs FilePath & cell.Value & ".xlsx", 51
                .Close False
            End With
            Set wbTemplate = Nothing
        Next cell
            
    Else
        MsgBox FilePath & FileName & Chr(10) & Chr(10) & "FileName \ Folder Not Found", 48, "Not Found"
            
    End If
'
End Sub

Dave
 

PatOBrien198

Board Regular
Joined
Sep 13, 2017
Messages
236
on the line right before the line that is giving you the error add this....

Msgbox FilePath & FileName

my guess is that you are missing a slash between the path and the name

wait... the code revised above addresses this problem.
 
Last edited:

davidandrewlawrence

New Member
Joined
Feb 19, 2008
Messages
3
try this update

Code:
Sub LoopClusterAndSave()
    Dim rng As Range, cell As Range
    Dim wsPicACluster As Worksheet
    Dim wbTemplate As Workbook
    Dim FilePath As String, FileName As String
'
' 'PickACluster is the name of the worksheet with my data
    Set wsPicACluster = ThisWorkbook.Worksheets("PickACluster")
'
    FilePath = "C:\Users\00822593\Documents\Reports to send\"
    FileName = "BlankChartTemplate.xlsx"
    
    If Dir(FilePath & FileName, vbDirectory) <> vbNullString Then
        
''this is where my dropdown list populates from
        Set rng = ThisWorkbook.Worksheets("Cluster list").Range("A1:A24")
''Select the first cluster in the drop down list:
        For Each cell In rng.Cells
'
            wsPicACluster.Range("A1").Value = cell.Value
'
''Open the blank template document where we want to paste this data:
            Set wbTemplate = Workbooks.Open(FileName:=FilePath & FileName, ReadOnly:=True)
'
            With wbTemplate
                wsPicACluster.UsedRange.Copy .Sheets(1).Range("A1")
                .SaveAs FilePath & cell.Value & ".xlsx", 51
                .Close False
            End With
            Set wbTemplate = Nothing
        Next cell
            
    Else
        MsgBox FilePath & FileName & Chr(10) & Chr(10) & "FileName \ Folder Not Found", 48, "Not Found"
            
    End If
'
End Sub

Dave

Many thanks again for this, you guys are very helpful. I’vespent another half hour on this and I’m still stumped!

I tried the update, it gave me the error message box youadded straight away. I realised this was because I hadn’t put theblankcharttemplate workbook in the correct file location
I’ve now done this, and it gets as far as pasting the databut then gives another error (shown on code in comments).

My other problem, and I wasn’t clear enough about this, isthat the data that is pasted doesn’t seem to give everything I needed.
What I was trying to do was either make a copy of theworksheet, or select all cells in the worksheet and paste (this is because theworksheet contains graphs, and the graphs are not being copied across, not surewhy).

Hope that makes sense.
 

PatOBrien198

Board Regular
Joined
Sep 13, 2017
Messages
236
Rather than copying all of the cells of the worksheet, do a Worksheet "Move or Copy".

try recording a macro to get the syntax - when you right click the sheet name, select "Move or Copy", Change the "To Book" name then [OK]
 

Forum statistics

Threads
1,147,823
Messages
5,743,405
Members
423,792
Latest member
travisds

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