importazione contatti su gmail

Sub eliminarighevuote()
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "" Then
Exit Sub
Else
Target.Value = UCase(Target.Value) 'tutto maiuscolo
'Target.Value = LCase(Target.Value) 'tutto minuscolo
'Target.Value = Application.WorksheetFunction.Proper(Target.Value) 'iniziale maiuscola
End If
End Sub

Sub crea_csv()
    Dim MyDir As String, NomeFile As String
    Dim FileExist As Boolean, ws As Worksheet
    Application.ScreenUpdating = False

    MyDir = ThisWorkbook.Path
    NomeFile = ActiveSheet.Name
    

    If Dir(MyDir & "" & NomeFile & ".csv") <> "" Then
        Select Case MsgBox("Attenzione: esiste già un file con questo nome." _
                           & vbCrLf & "Vuoi sovrascrivere il file?" _
                           , vbYesNo Or vbExclamation Or vbDefaultButton1, "Duplicato")
        Case vbNo
            Exit Sub
        End Select
    End If
    
    Application.DisplayAlerts = False
    
    'Sheets(NomeFile).Copy
    'With ActiveWorkbook
    '    .SaveAs Filename:=MyDir & "" & NomeFile & ".csv", FileFormat:=xlCSV
    '    .Close savechanges:=False
    'End With


   For Each ws In ThisWorkbook.Worksheets
       ws.Copy 'creates a new workbook
       With ActiveWorkbook
     '       .SaveAs "C:\temp\" & ws.Name & "_blah.csv", xlCSV
             .SaveAs Filename:=MyDir & "" & NomeFile & ".csv", FileFormat:=xlCSV
             .Close savechanges:=False
     '       .Close False
       End With
   Next ws

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "Foglio .csv creato con successo"
End Sub

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
    On Error Resume Next
    
'TUTTA LA COLONNA A e B IN MAIUSCOLO
    If Not Intersect(Target, Range("A:B")) Is Nothing Then
        Application.EnableEvents = False
        Target = UCase(Target)
        Application.EnableEvents = True
    End If
End Sub



Sub crea_csv()
    Dim MyDir As String, NomeFile As String
    Dim FileExist As Boolean
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' cancella l'intera riga se nella colonna A non c'è scritto nulla
    On Error Resume Next
    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    MyDir = ThisWorkbook.Path
    NomeFile = ActiveSheet.Name
    

    If Dir(MyDir & "\" & NomeFile & ".csv") <> "" Then
        Select Case MsgBox("Attenzione: esiste già un file con questo nome." _
                           & vbCrLf & "Vuoi sovrascrivere il file?" _
                           , vbYesNo Or vbExclamation Or vbDefaultButton1, "Duplicato")
        Case vbNo
            Exit Sub
        End Select
    End If
    
    Application.DisplayAlerts = False
    
 
    With ActiveWorkbook
        .SaveAs Filename:=MyDir & "\" & NomeFile & ".csv", FileFormat:=xlCSV, Local:=True
        .Close savechanges:=False
    End With


    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "Foglio .csv creato con successo"
End Sub