Excel VBA从一张纸复制到另一张纸不会覆盖数据

我使用vba将数据从一个wb导入到另一个wb – 但是好像数据没有被覆盖。

恩。

wb 1单元格A2包含数字“2”并被复制到wb 2单元格A2。 但是，如果我从wb 2中删除单元格A2，并再次运行vba – 没有数据inputwb 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对象引用，并且完全限定列范围引用以search最后一行

函数签名和它的伪代码是：

 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