复制并粘贴到已关闭的工作簿

时间:2017-08-18 01:38:06

标签: excel vba excel-vba csv

我的问题是是否可以复制并粘贴到已关闭的工作簿,然后将其另存为CSV?第一个工作簿是活动的,虽然我认为复制(从一个已关闭的工作簿)和粘贴(到一个已关闭的工作簿)将是理想的但不是必要的。

对不起,如果这是一个愚蠢的问题,我只是想知道为了节省我的CPU任何不必要的困难而且必须打开这么多的擅长。

下面的代码往往运行得很好,但我很难知道如何粘贴到特定的CSV然后保存它,因为通常它们必须是活动的。

尽管如此我可以将已关闭的工作簿复制到活动工作簿,但我要求相反。

非常感谢任何帮助:)。

Option Explicit

    Sub copytoarchive()
    Dim wb1 As Excel.Workbook
    Set wb1 = Workbooks.Open("C:\Users\Excel.xlsx")
    Dim wb2 As Excel.Workbook
    Set wb2 = Workbooks.Open("C:\Users\CSV.csv")
    wb1.Sheets("Sheet1").Range("A1:Z10000").Copy
    wb2.Sheets("Sheet1").Range("a65536").End(xlUp).Offset(1, 0).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    wb1.Close SaveChanges:=True
    End Sub

3 个答案:

答案 0 :(得分:1)

您需要打开一个文件才能写入。但是,在这种特定情况下,因为.csv文件是分隔的文本文件,所以无需在Excel中打开它即可对其进行写入。我不知道它是否真的更快,但你可以尝试一下。像这样:

Option Explicit

Sub copytoarchive()
Dim wb1 As Excel.Workbook
Set wb1 = Workbooks.Open("C:\Users\Excel.xlsx")

'//Set variables to help with delimiting the workbook contents
Dim row As Range
Dim col As Long
Dim sRowContents As String

'//Open the file for Append
Open "C:\Users\CSV.csv" For Append As #1

'//Work through each row, and create a comma delimited set of the contents
For Each row In wb1.Sheets("Sheet1").Range("A1:Z10000").Rows
    For col = 1 To row.Columns.Count
        sRowContents = sRowContents & row.Cells(1, col).Value & ","
    Next col
    Print #1, sRowContents  '//<= This is where the delimted line gets added.
    sRowContents = ""    '//Clear the value for the next row.
Next row
Close #1

wb1.Close SaveChanges:=True
End Sub    

答案 1 :(得分:0)

也许这就是。

Sub CopynPasteWrkBk()
Dim InputFile As Workbook
Dim OutputFile As Workbook
Dim Inputpath As String
Dim Outputpath As String'

' Set path for Input & Output 
fileInputpath = "D:\"
Outputpath = "D:\Output\"

'## Open both workbooks first:
Set InputFile = activeworkbook
Set OutputFile = Workbooks.Open(Outputpath & "Time.xlsx")

'Now, copy what you want from InputFile:
InputFile.Sheets("Sheet2").Activate
InputFile.Sheets("Sheet2").Range("B1:K100").Copy

'Now, paste to OutputFile worksheet:
OutputFile.Sheets("Sheet1").Activate
OutputFile.Sheets("Sheet1").Range("A1").PasteSpecialOutputFile.Save

'Close InputFile & OutputFile:
InputFile.Close
OutputFile.Close

End Sub

答案 2 :(得分:0)

AFAIK,哟,你要打开文件。也许这会做你想要的......

Sub ImportDatafromcloseworkbook()
'Update 20150707
Dim xWb As Workbook
Dim xAddWb As Workbook
Dim xRng1 As Range
Dim xRng2 As Range
Set xWb = Application.ActiveWorkbook
xTitleId = "KutoolsforExcel"
With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        Application.Workbooks.Open .SelectedItems(1)
        Set xAddWb = Application.ActiveWorkbook
        Set xRng1 = Application.InputBox(prompt:="Select source range", Title:=xTitleId, Default:="A1", Type:=8)
        xWb.Activate
        Set xRng2 = Application.InputBox(prompt:="Select destination cell", Title:=xTitleId, Default:="A1", Type:=8)
        xRng1.Copy xRng2
        xRng2.CurrentRegion.EntireColumn.AutoFit
        xAddWb.Close False
    End If
End With
End Sub

End Sub