Hello all,
After much experimentation I've managed to get some loop code working to speed up a project I have.Currently, the code looks through a long worksheet to find a specific name in a column, then, copies the entire row to another worksheet which matches the name required. Then, it saves a copy of that worksheet to a workbook on my desktop.
I was wondering if there was a way to get this information copied in to a template workbook, save that with a specific name, then move on to the next name in the list and repeat the process. Open a template work book containing three worksheets, loop through main workbook to find name X, copy all rows where X exists and copy in to sheet 1 of the template workbook, save as name X, then move on to the next one until complete.
Please see below some code I'm using to do this, as I don't know how to export to an existing workbook, I've had to add in extra bits to format the results (remove blank rows), edit the header row, then save each worksheet to a seperate workbook.
Apologies if the above is a bit too vague, but I was wondering if there was a way to do what I would like. It's no huge issue if not, it will just stop and awful lot of copy pasting.
Sub CopyRows()
'copies info to new worksheet in existing workbook
Dim bottomL As Integer
Dim x As Integer
bottomG = Sheets("ScheduleView").Range("G" & Rows.Count).End(xlUp).Row: x = 2
Dim c As Range
For Each c In Sheets("ScheduleView").Range("G1:G" & bottomG) 'change the F's to whatever column is required to use, eg coordinator column
If c.Value = "Peter Griffin" Then
c.EntireRow.Copy Worksheets("2018 Schedule - P Griffin").Range("A" & x)
x = x + 1
ElseIf c.Value = "Randy Marsh" Then
c.EntireRow.Copy Worksheets("2018 Schedule - R Marsh").Range("A" & x)
x = x + 1
ElseIf c.Value = "Butters Stotch" Then
c.EntireRow.Copy Worksheets("2018 Schedule - B Stotch").Range("A" & x)
x = x + 1
End If
Next c
'try and remove the need for lots of calls with case statement s for the C variable. To test.
'Call DeleteAllBlankCells
'Call ExportToWorkbooks
End Sub
Sub ExportToWorkbooks()
Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set OldBook = ThisWorkbook
'possibly change the If statement to if portected = false, then export it??? Also consider else if save as excel 97-2003 for the coords with old Excel??
For Each sh In OldBook.Worksheets
If sh.Visible = True Then
sh.Copy
ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & sh.Name, FileFormat:=xlOpenXMLWorkbook 'possibly change to excel 97-2003 with else if?
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub DeleteAllBlankCells()
Sheets("2018 Schedule - P Griffin").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("2018 Schedule - R Marsh").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Sheets("2018 Schedule - B Stotch").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub