excel 粘贴选定的行到另一个工作表而不改变工作表

osh3o9ms  于 2023-04-22  发布在  其他
关注(0)|答案(2)|浏览(119)

我已经有代码来做我想做的事情,但我希望它更快。
我从一个单元格中复制了一行,然后VBA更改工作表,选择该行并粘贴我复制的选择,然后将工作表保存为PDF。

Sub Sheet2()
    Selection.Copy
    Sheets("Sheet2").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    Dim Path As String
    Dim Sect As String
    Dim Sectslash As String
    Dim fisier As String
    Dim director As String
    Path = "C:\work"
    Sect = Range("X1")
    Sectslash = Range("X1") & "\"
    fisier = Range("A1")
    director = Path & Sectslash
    If Dir(Path & Sectslash, 16) <> vbNullString Then
    Else
    MkDir director
    End If
If IsEmpty(Range("B1")) = True Then
    ActiveSheet.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
    Sheets("Sheet1").Select
    ActiveCell.Offset(1, 0).EntireRow.Select
Else
    Sheets("Sheet3").Select
    Rows("1:1").Select
    ActiveSheet.Paste
    ActiveSheet.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & uatslash & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
    Sheets("Sheet1").Select
    ActiveCell.Offset(1, 0).EntireRow.Select
End If
End Sub
  • 这是一个不工作(行Sheets(“Sheet2”).行(“1.1”).粘贴是不好):我试图使它更快...我想粘贴选择sheet2在第一行,但没有选择sheet2,并保存sheet2为PDF.我有一个很好的代码,但慢,比我有什么我tryed做...但不工作 *
Sub Sheet2()
    Selection.Copy
    Sheets("Sheet2").Rows("1.1").Paste
    Dim Path As String
    Dim Sect As String
    Dim Sectslash As String
    Dim fisier As String
    Dim director As String
    Path = "C:\work\"
    Sect = Sheets("Sheet2").Range("X1")
    Sectslash = Sheets("Sheet2").Range("X1") & "\"
    fisier = Sheets("Sheet2").Range("A1")
    director = Path & Sectslash
    If Dir(Path & Sectslash, 16) <> vbNullString Then
    Else
    MkDir director
    End If
If IsEmpty(Sheets("Sheet2").Range("B1")) = True Then
    Sheets("Sheet2").Copy
    Sheets("Sheet2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
    ActiveCell.Offset(1, 0).EntireRow.Select
Else
    Selection.Copy Sheets("Sheet3").Rows("1:1").Paste
    Sheets("Sheet3").Copy
    Sheets("Sheet3").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & uatslash & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close False
    ActiveCell.Offset(1, 0).EntireRow.Select
End If
End Sub
7kjnsjlb

7kjnsjlb1#

您的原始代码只在一行上运行,并且只创建一个文件。您没有给出任何指示,说明如何循环遍历所有行,也没有给出任何指示,说明您认为“快”或“慢”。下面的方法可能会起作用,但如果您共享所有代码,它的运行速度以及您希望它运行的速度,则会有所帮助。
这段代码将遍历从第1行开始的所有行,直到A列中的第一个空单元格。
我保留了原来不必要的代码行,但将它们注解掉,这样它们就不会减慢速度。

Sub Sheet2()

Dim LastRow As Long

LastRow = Sheets("Sheet1").Range("A1").End(xlDown).Row

For Each rg In Sheets("Sheet1").Range("A1:A" & LastRow)

    '    Selection.Copy
    '    Sheets("Sheet2").Rows("1.1").Paste
        Sheets("Sheet2").Range("1:1") = rg.EntireRow.Value
        
        Dim Path As String
        Dim Sect As String
        Dim Sectslash As String
        Dim fisier As String
        Dim director As String
        Path = "C:\work\"
        Sect = Sheets("Sheet2").Range("X1")
        Sectslash = Sheets("Sheet2").Range("X1") & "\"
        fisier = Sheets("Sheet2").Range("A1")
        director = Path & Sectslash
        If Dir(Path & Sectslash, 16) <> vbNullString Then
        Else
        MkDir director
        End If
    If IsEmpty(Sheets("Sheet2").Range("B1")) = True Then
'        Sheets("Sheet2").Copy
        Sheets("Sheet2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'        ActiveWorkbook.Close False
'        ActiveCell.Offset(1, 0).EntireRow.Select
    Else
        Selection.Copy Sheets("Sheet3").Rows("1:1").Paste
'        Sheets("Sheet3").Copy
        Sheets("Sheet3").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & uatslash & Sectslash & fisier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'        ActiveWorkbook.Close False
'        ActiveCell.Offset(1, 0).EntireRow.Select
    End If

Next rg

End Sub
ctehm74n

ctehm74n2#

而不是

Selection.Copy
Sheets("Sheet2").Rows("1.1").Paste

使用

Sheets("Sheet2").Range("1:1") = Selection.Value

在我的测试中,代码在空的Excel工作表上立即运行。你认为什么是慢?
如果Sheet2上有很多内容,并且要将其保存为PDF文件,这将花费时间,但这与您的代码无关,并且无法通过使用VBA来加速。
如果您通过文件〉另存为〉另存为类型pdf手动保存文件需要多长时间?VBA无法使Excel工作得更快。
如果你从一个空的工作簿开始,空的Sheet2,并且只有Sheet1 Ranges A1和X1中的值,那么需要多长时间?这就是代码运行的速度。任何比这更长的时间都是由于Sheet2的内容。

相关问题