我目前有这个代码,我试图将数据导出到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检索工作簿名称和工作表名称的任何想法?
答案 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