将数据导出为CSV文件并从源工作簿中检索文件名

时间:2014-09-24 18:23:59

标签: excel vba excel-vba csv

我目前有这个代码,我试图将数据导出到CSV文件,我想从CSV文件本身导出的源工作簿中显示工作簿名称和工作表。到目前为止,我有以下代码:

Sub CopyPasteBetween2Books()

  Dim wb As Workbook
  ThisWorkbook.Sheets(1).Range("B7:E26,B39:E138").Copy
  Selection.Copy
  ActiveSheet.Paste
  wbname2 = ActiveWorkbook.Name
  wsname2 = ActiveSheet.Name
  Workbooks.Add
  ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A1")
  wbname = "Y:\Data.csv"
  ActiveWorkbook.SaveAs wbname
  Set wb = Workbooks.Open("Y:\SQCData.csv")
  ActiveCell.Offset(0, 8).Value = wbname2
  ActiveCell.Offset(0, 9).Value = wsname2

  Application.CutCopyMode = False
End Sub

到目前为止,此代码仅从我从中导出数据的位置获取工作簿名称和工作表名称。但是,从范围指定的数据不会复制到CSV文件中。有关如何导出数据以及从源workbbok检索工作簿名称和工作表名称的任何想法?

2 个答案:

答案 0 :(得分:0)

您可以指定要放置文件名和工作表名称的范围

 Sub CopyPasteBetween2Books()

  Dim wb As Workbook
  ThisWorkbook.Sheets(1).Range("B7:E26,B39:E138").Copy
  Selection.Copy
  ActiveSheet.Paste
  wbname2 = ActiveWorkbook.Name
  wsname2 = ActiveSheet.Name
  Workbooks.Add
  ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A1")
  Worksheets("Sheet1").Range("A8").value = wbname2
  Worksheets("Sheet1").Range("A9").value = wsname2
  wbname = "Y:\Data.csv"
  ActiveWorkbook.SaveAs wbname
  Set wb = Workbooks.Open("Y:\SQCData.csv")


  Application.CutCopyMode = False
End Sub

答案 1 :(得分:0)

认为这符合您的目的:

Option Explicit

Sub saveasCSV()
'modify offset and path if required

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wbDestin As Workbook, wbSource As Workbook
Dim Source As String, Destin As String, wbname2 As String, wsname2 As String

Source = ThisWorkbook.FullName
Destin = "Y:\Data.csv"
wbname2 = ActiveWorkbook.Name
wsname2 = ActiveSheet.Name

ActiveWorkbook.SaveAs Destin

ThisWorkbook.Worksheets("Sheet1").Activate
Set wbDestin = ThisWorkbook

ActiveCell.Offset(0, 8).Value = wbname2
ActiveCell.Offset(0, 9).Value = wsname2
ActiveWorkbook.Save

Set wbSource = Workbooks.Open(Source)
wbSource.Sheets(1).Range("B3:C4,B7:C8").Copy
wbSource.Close

'wbDestin.Sheets(1).Range("A12").Select
wbDestin.Sheets(1).Cells(15, 2).Offset(4, 1).Select
ActiveSheet.Paste
wbDestin.Save

Set wbSource = Nothing
Set wbDestin = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub