Excel VBA копия с одного листа на другой wb не перезаписывает данные

Question

Я использую vba для импорта данных из одного wb в другой, но, похоже, данные не перезаписываются.

ex.

wb 1 ячейка A2 содержит номер "2" и скопирована в wb 2 ячейку A2. Но если я удалю ячейку A2 из wb 2 и снова запустил vba - нет данных, введенных в ячейку wb 2 A2 ... Может ли кто-нибудь понять, почему это так?

С уважением Brian

К сожалению забыл добавить код: о)

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