Help on Macro please!

Hajduk1908

New Member
Joined
Aug 16, 2015
Messages
13
Hello

I have a macro to create a menu of all my worksheets in my workbook. I am given an option in the menu to select a worksheet, delete a certain number of rows then extract the remainer as CSV to my local computer. In this macros case its the first 10 rows however I now have the problem where the rows will vary for eg. On Worksheet name Monday I need to delete the first 10 rows and then extract the remaining information as a csv to my local computer. On Tuesday it could be the first 20 rows and the remaining rows will need to be extracted to a csv. On Wednesday it could be the first 2 row etc etc. In the macro on select it will delete the first 10 rows and extract but how could I vary it for the detail I need ..thanks in advance
Thanks in advance
Code:
Sub SheetActivater()
 Const ColItems  As Long = 15
 Const LetterWidth As Long = 15
 Const HeightRowz As Long = 18
 Const SheetID As String = "__SheetSelection"
Dim i%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
 optCaption = "": i = 0
   Application.ScreenUpdating = False
MsgBox "Have you saved this spreadsheet into a folder called Test on your desktop?"
On Error Resume Next
 Application.DisplayAlerts = False
 ActiveWorkbook.DialogSheets(SheetID).Delete
 Application.DisplayAlerts = True
 Err.Clear
Set wsDlg = ActiveWorkbook.DialogSheets.Add
With wsDlg
 .Name = SheetID
 .Visible = xlSheetHidden
 iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 78: TopPos = 40
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
 i = i + 1
If i Mod ColItems = 1 Then
 optCols = optCols + 1
 TopPos = 40
 optLeft = optLeft + (optMaxChars * LetterWidth)
 optMaxChars = 0
End If
 intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
 iSet = iSet + 1
 .OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16.5
 .OptionButtons(iSet).Text = objSheet.Name
 TopPos = TopPos + 10
End If
Next objSheet
If i > 0 Then
   .Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 2
   With .DialogFrame
   .Height = Application.Max(68, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 2)
   .Width = optLeft + (optMaxChars * LetterWidth) + 2
   .Caption = "Select the table(s) you want to export as a CSV?"
   End With
   .Buttons("Button 2").BringToFront
   .Buttons("Button 3").BringToFront
   If .Show = True Then
   For Each objOpt In wsDlg.OptionButtons
   If objOpt.Value = xlOn Then
   optCaption = objOpt.Caption
   Exit For
   End If
   Next objOpt
   End If
   If optCaption = "" Then
   MsgBox "You did not select a worksheet.", 48, "Cannot continue"
   Application.ScreenUpdating = True
   Exit Sub
   Else
   'MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
  Sheets(optCaption).Activate
  
  
   For Each ws In ActiveWindow.SelectedSheets
              
        ws.Rows("1:10").Delete ' Delete 10 rows at top of each sheet.
        ws.Copy
        Range("A1").Interior.Color = 1  ' Format A1 so the top rows are included in the used range and saved
        ActiveWorkbook.SaveAs Filename:=path & "_" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        ActiveWorkbook.Close SaveChanges = False
              
   Next ws
   
     
   
   strFormWS = optCaption
   End If
End If
 Application.DisplayAlerts = False
 .Delete
 Application.DisplayAlerts = True
End With
   Application.ScreenUpdating = True
   
  MsgBox "Done! If you need to do another export please return to the Export to CSV menu and select again or exit this spreadsheet without saving"
  MsgBox "If you have problems importing run the CleanCSV function and retry inport "
   
    
   
End Sub
 
Last edited by a moderator:

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Forum statistics

Threads
1,215,446
Messages
6,124,897
Members
449,194
Latest member
JayEggleton

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
Back
Top