Question

我有一个visual basic的问题，我想生成一个只有3列的csv，它将是BMR，我在这里有一个代码，但它不仅生成3列而且整个工作表，你能帮助吗？我吗？

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

修改
我做了一个小修改（@Pehs回答）才能正常运行，但是我现在离开它的方式只需要“20”这条线我怎么能做OffSet？我尝试了几种方式，但没有用。（我是巴西人，我正在使用谷歌翻译，巴西人不喜欢自己帮助）谢谢。

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

Answer 1

这是因为您使用abaPlan.Copy复制了整个工作表，但您只需要复制一些列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

注意
我建议使用

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

而不是硬编码路径。

另请注意，使用R13中的name而不检查它是否只包含对文件名有效的字符可能会导致错误。

将工作表的3列保存为CSV（使用VBA）

1 个答案: