Snasui Excel Forum

Code: Select all

Sub SaveRangeToCSV()

    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim rngToSave As Range

    Application.DisplayAlerts = False
    On Error GoTo err

    Set myWB = ThisWorkbook
    myCSVFileName = myWB.Path & "\" & "Score" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & ".csv"
'    Set rngToSave = Range("F6:S50")
    Set rngToSave = Range("F6:S50,U6:V50,Z6:AM50,AO6:AP50")
    rngToSave.Copy
    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With

err:
    Application.DisplayAlerts = True
End Sub

Code: Select all

Sub ImportCSVFile()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  '
  Application.ScreenUpdating = False
    fileFilterPattern = "Text Files (*.txt; *.csv),*.txt;*.csv"
  fileToOpen = Application.GetOpenFilename(fileFilterPattern)
  If fileToOpen = False Then
    MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
  Else
    Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, Local:=True
    Set wbTextImport = ActiveWorkbook
    Set wsMaster = ThisWorkbook.Worksheets("ภาษาไทย2")
    wsMaster.Range("F6:S50,U6:V50,Z6:AM50,AO6:AP50").ClearContents
    wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
    wsMaster.Range("F6").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    wbTextImport.Close False
  End If
  Application.ScreenUpdating = True
  Range("F6").Select
End Sub

Code: Select all

'Other code
wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
    wsMaster.Range("F6").PasteSpecial xlPasteValues
    'Other code

Code: Select all

'Other code
    wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
    wsMaster.Range("F6:S50").PasteSpecial xlPasteValues
        wbTextImport.Worksheets(1).Range("P1").CurrentRegion.Copy
    wsMaster.Range("U6:V50").PasteSpecial xlPasteValues
................................................................................
   'Other code

Code: Select all

myCSVFileName = myWB.Path & "\" & "Score" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & ".csv"

Code: Select all

Sub ImportCSV()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  '
    If MsgBox("ต้องการนำเข้าผลการเรียน?", 36, "โปรดยืนยัน") = 6 Then
        Application.ScreenUpdating = False
        fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้า", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
        If fileToOpen = False Then
                MsgBox "ไม่ได้เลือกไฟล์นำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้า"
        Else
            Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
                Set wbTextImport = ActiveWorkbook
                Set wsMaster = ThisWorkbook.Worksheets("Math")
                wsMaster.Unprotect Password:="1165"
                wsMaster.Range("F6:S50,U6:V50,Z6:AM50,AO6:AP50").ClearContents
                       wbTextImport.Worksheets(1).Range("A1:N50").Copy
                        wsMaster.Range("F6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("O1:P50").Copy
                        wsMaster.Range("U6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("Q1:AD50").Copy
                        wsMaster.Range("Z6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("AE1:AF50").Copy
                        wsMaster.Range("AO6").PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                    wbTextImport.Close False
        Range("F6").Select
                wsMaster.Protect Password:="1165"
    End If
        End If
Exit Sub
        Application.ScreenUpdating = True
                wsMaster.Protect Password:="1165"
End Sub