Question

我想将值从一个excel文件复制到另一个excel文件，但在项目的后期阶段，我可能需要交叉检查该值，然后将其粘贴到新的excel文件中。所以我不想一次复制整张纸。我想按值复制一个值。

我能够打开并切换到excel文件，但我无法复制和粘贴值。以下是我试过的代码 -

Private Sub CommandButton1_Click()
Dim x As Long
Dim NumRows As Long
Set fromwb = Workbooks.Open("G:\Excel\From.xlsx")
Set towb = Workbooks.Open("G:\Excel\To.xlsx")
fromwb.Activate
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
ReDim a(1 To NumRows)

For x = 1 To NumRows
    fromwb.Activate
    a(x) = Cells(x, 1).Value

    towb.Activate
    Cells(x, 1).Value = a(x)
Next x

End Sub

在期待中感谢你。

Answer 1

你只需要指定to cells等于from cells，不需要循环任何东西。

Workbooks("To.xlsx").Sheets("ToSheetNameHere").Range("rangehere").Value = Workbooks("From.xlsx").Sheets("FromSheetNameHere").Range("rangehere").Value

请记住，如果您在工作簿中有宏代码，那么它们将是.xlsm而不是.xlsx

Answer 2

试试下面的代码。我希望评论非常明确！

Option Explicit
Private Sub CommandButton1_Click()

Dim SourceBook As Workbook, DestBook As Workbook
Dim SourceSheet As Worksheet, DestSheet As Worksheet
Dim Index As Long, NumRows As Long
Dim ValidCheck As Boolean

'set references up-front
Set SourceBook = Workbooks.Open("G:\Excel\From.xlsx")
Set SourceSheet = SourceBook.ActiveSheet
With SourceSheet
    NumRows = .Range("A", .Rows.Count).End(xlUp).Row '<~ last row in col A
End With
Set DestBook = Workbooks.Open("G:\Excel\To.xlsx")
Set DestSheet = DestBook.ActiveSheet

'loop through col A and write out values to destination
For Index = 1 To NumRows

    '...
    'do your value validation
    'in this space using ValidCheck
    '...

    If ValidCheck Then '<~ if true write to Dest
        DestSheet.Cells(Index, 1) = SourceSheet.Cells(Index, 1)
    End If '<~ if not, do not write to Dest

Next Index

End Sub

逐个单元地将值从一个excel复制到另一个excel

2 个答案: