简体   繁体   中英

Save 3 Columns of a Worksheet as CSV (with VBA)

I have a problem with visual basic, I would like to generate a csv with only 3 columns, it would be BMR, I have a code here but it is not only generating the 3 columns but the whole worksheet, could you help me?

Sub GravaTXT()
    Dim pasta As Workbook
    Dim abaPlan As Worksheet
    Dim b As Range
    Dim m As Range
    Dim r As Range
    Dim name As String
    name = Range("R13").Value

    Set b = ActiveCell.EntireColumn("B")
    Set m = ActiveCell.EntireColumn("M")
    Set r = ActiveCell.EntireColumn("R")
    Set abaPlan = ThisWorkbook.Worksheets("Orcamento")
    Set pasta = Application.Workbooks.Add

    abaPlan.Copy Before:=pasta.Worksheets(pasta.Worksheets.Count)
    Application.DisplayAlerts = False
    pasta.SaveAs Filename:="C:\Users\alcir.scarmin\Desktop\" & name & ".csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    pasta.Close SaveChanges:=False
End Sub

Edit
I made a small modification (of @Pehs answer) to be able to run correctly, but the way I left it now it only takes the line "20" how can I make OffSet? I tried in several ways and it did not work. (I'm Brazilian, I'm using google translator, Brazilian people do not like to help themselves) Thank you.

Sub GravaTXT()
    Dim abaPlan As Worksheet
    Set abaPlan = ThisWorkbook.Worksheets("Orcamento")

    Dim name As String
    name = abaPlan.Range("R13").Value

    Dim pasta As Workbook
    Set pasta = Application.Workbooks.Add


    abaPlan.Range("B20,M20,R20").Copy pasta.Worksheets(1).Range("A1")
    pasta.Worksheets(1).name = abaPlan.name

    Application.DisplayAlerts = False
    pasta.SaveAs Filename:="C:\Users\alcir.scarmin\Desktop\" & name & ".csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    pasta.Close SaveChanges:=False
End Sub

This was because you copied the whole worksheet with abaPlan.Copy but you only need to copy some columns abaPlan.Range("B:B,M:M,R:R").Copy .

Option Explicit

Sub GravaTXT()
    Dim abaPlan As Worksheet
    Set abaPlan = ThisWorkbook.Worksheets("Orcamento") 'source workbook

    Dim name As String
    name = abaPlan.Range("R13").Value 'always refer ranges to a specific worksheet

    Dim pasta As Workbook
    Set pasta = Application.Workbooks.Add

    'copy columns B, M and R to new workbook first worksheet
    abaPlan.Range("B:B,M:M,R:R").Copy pasta.Worksheets(1).Range("A1")
    pasta.Worksheets(1).Name = abaPlan.Name 'rename the first worksheet to the same name as abaPlan

    Application.DisplayAlerts = False
    pasta.SaveAs Filename:="C:\Users\alcir.scarmin\Desktop\" & name & ".csv", FileFormat:=xlCSV
    Application.DisplayAlerts = True
    pasta.Close SaveChanges:=False
End Sub

Note
I recommend to use

Filename:=Environ("userprofile") & "\Desktop\" & name & ".csv"

instead of a hard coded path.

Also be aware that using the name from R13 without a check if it only contains characters that are valid for a filename could result in errors.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM