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

[davidandrewlawrence]

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

 

[PatOBrien198]

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]

Hi welcome to forum

Untested but see if update to your code helps

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]

Hi welcome to forum

Untested but see if update to your code helps

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]

try this update

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]

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.

 

[davidandrewlawrence]

try this update

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]

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]