Question

我使用vba将数据从一个wb导入到另一个wb - 但似乎数据没有被覆盖。

离。

wb 1个单元格A2包含数字“2”并被复制到wb 2单元格A2。但是如果我从wb 2删除单元格A2，并再次运行vba - 在wb 2单元格A2中没有输入数据... 谁能明白这是为什么？

此致布赖恩

抱歉忘记添加代码：o）

Sub GetData()
Dim strWhereToCopy As String, strStartCellColName As String
Dim strListSheet As String

Application.ScreenUpdating = False

strListSheet = "List"

On Error GoTo ErrH
Sheets(strListSheet).Select
Range("B2").Select

'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
Set currentWB = ActiveWorkbook
Do While ActiveCell.Value <> ""

    strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
    strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)

    strWhereToCopy = ActiveCell.Offset(0, 4).Value
    strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)

    Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
    Set dataWB = ActiveWorkbook

    Range(strCopyRange).Select
    Selection.Copy

    currentWB.Activate
    Sheets(strWhereToCopy).Select
    lastRow = LastRowInOneColumn(strStartCellColName)
    Cells(lastRow + 1, 1).Select

    Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False
    dataWB.Close False
    Sheets(strListSheet).Select
    ActiveCell.Offset(1, 0).Select

Loop
Sheets(strListSheet).Select
Range("B2").Select
Exit Sub

ErrH:
MsgBox "It seems some file was missing. The data copy operation is not complete."
Exit Sub
'Application.ScreenUpdating = True

End Sub

Answer 1

你可以复制wb1并将其作为wb2

过去

Sub Copy_One_File()

        Dim  wb1, wb2 As String
        wb1 = ActiveWorkbook.Path & "wb1.xlsm"
        wb2 = ActiveWorkbook.Path & "wb2.xlsm"
        FileCopy wb1, wb2

End Sub

这是最简单的方法

Answer 2

您应该避免使用Select / Selection / Activate / ActiveXXX模式来支持完全限定的范围参考

类似于以下（注释）代码：

Option Explicit

Sub GetData()
    Dim strWhereToCopy As String, strStartCellColName As String
    Dim strFileName As String
    Dim strCopyRange As Range, cell As Range
    Dim LastRow As Long

    With Sheets("List") '<--| reference your "List" worksheet
        For Each cell In .Range("B2", .Cells(.Rows.count, "B").End(xlUp)).SpecialCells(xlCellTypeConstants) '<--| loop through its column "B" not empty cells form row 2 down to last not empty one
            With cell '<--| reference current cell
                strFileName = .Offset(0, 1) & .Value
                strCopyRange = .Offset(0, 2) & ":" & .Offset(0, 3)
                strWhereToCopy = .Offset(0, 4).Value
                strStartCellColName = Mid(.Offset(0, 5), 2, 1)
            End With

            On Error GoTo ErrH '<--| activate error handler for subsequent file open statement
            Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
            On Error GoTo 0 '<--| resume "default" error handling

            Range(strCopyRange).Copy '<-- without a leading dot (.) the range referes to the currently active worksheet, which is the active one in the just opened workbook
            With .Parent '<--| reference workbook where currently referenced Sheet "List" resides in
                LastRow = LastRowInOneColumn(.Worksheets(strWhereToCopy), strStartCellColName) '<--| your 'LastRowInOneColumn' function must be passed a worksheet reference, too
                With .Worksheets(strWhereToCopy).Cells(LastRow + 1, 1) '<--| reference 'strWhereToCopy' named worksheet in the referenced workbook
                    .PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
                    .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Application.CutCopyMode = False
                End With
            End With
            ActiveWorkbook.Close False
        Next cell
        .Activate
        .Range("B2").Select
    End With
    Exit Sub

ErrH:
    MsgBox "It seems some file was missing. The data copy operation is not complete."

End Sub

根据评论，您的LastRowInOneColumn函数也必须传递worksheet对象引用，并完全限定列范围引用以搜索

中的最后一行

函数签名及其伪代码为：

Function LastRowInOneColumn(sht As Worksheet, strStartCellColName As String) As Long
    With sht

        'here goes your actual 'LastRowInOneColumn' code
        ' only you have to put a dot (.) before each range reference

    End With
End Function

从一个工作表到另一个工作表的Excel VBA复制不会覆盖数据

2 个答案: