从CSV中复制单元格区域并粘贴到特定工作表的底部

Question

我每月导出客户信息的CSV，并将其导入到现有的主工作表中。前台工作人员手动将数据复制并粘贴到表格中，导致数据准确性出现大量问题。

我被赋予了"；简化它"；所以…我决定制作一个宏，让前台可以点击"；"更新"；它会弹出一个资源管理器窗口，他们可以选择当月的下载CSV，它只需复制CSV表中的范围(我在宏中有这个范围(，并将其添加到主工作表的底部，添加当年的总数。

问题：我导入的CSV将覆盖粘贴目标的整个工作表。知道如何阻止这种情况吗？

Sub UpdateServicesData()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
FileToOpen = Application.GetOpenFilename("CSV or Text Files: ,*.csv;*.txt*", , "Browse for your File to Import")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
If OpenBook.Worksheets(1).Range("A2").Value >= ThisWorkbook.Worksheets("Home").Range("C3").Value Then
OpenBook.Sheets(1).Range("A2:L10000").Copy
Workbooks("TEB.xlsm").Activate
Sheets("Services Data").Select
lrTarget = Cells.Find("*", Cells(3, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
Cells(lrTarget + 1, 1).Select
ActiveSheet.PasteSpecial
Columns("A:L").AutoFit
Cells(1, 1).Select
OpenBook.Close False
End If
End If
End Sub

Answer 1

代码中的这一行从第3行第1列开始查找包含数据的上一个单元格，当您粘贴到第2行时，它会找到并覆盖您的数据。很肯定这就是原因。

lrTarget = Cells.Find("*", Cells(3, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row 

一个几乎是强制性的链接，如何避免主动&选择：如何避免在excel vba中使用选择。

试试这个代码。我已经拆分了findlast单元格，并将工作簿选择为单独的函数，这样更容易在其他项目中重用
它假定；服务数据"；工作表与VBA代码位于同一文件中。

Public Sub UpdateServiceData()
Dim FileToOpen As String
FileToOpen = GetFileName

If FileToOpen <> "" Then
Dim OpenBook As Workbook
Set OpenBook = Workbooks.Open(FileToOpen)

'Find last cell in CSV file.
Dim Source_LastCell As Range
Set Source_LastCell = LastCell(OpenBook.Worksheets(1))

'Find last cell in reporting workbook.
'ThisWorkbook means the file that the code is in.
Dim Target_LastCell As Range
Set Target_LastCell = LastCell(ThisWorkbook.Worksheets("Services Data")).Offset(1)

'Copy and paste - it's a CSV so won't contain formula, etc.
With OpenBook.Worksheets(1)
.Range(.Cells(2, 1), Source_LastCell).Copy _
Destination:=ThisWorkbook.Worksheets("Services Data").Cells(Target_LastCell.Row, 1)
End With

OpenBook.Close SaveChanges:=False

End If
End Sub
Public Function GetFileName() As String
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFilePicker)

With FD
.InitialFileName = ThisWorkbook.Path & Application.PathSeparator
.AllowMultiSelect = False
If .Show = -1 Then
GetFileName = .SelectedItems(1)
End If
End With

Set FD = Nothing
End Function
Public Function LastCell(wrkSht As Worksheet) As Range

Dim lLastCol As Long, lLastRow As Long

On Error Resume Next

With wrkSht
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
End With

If lLastCol = 0 Then lLastCol = 1
If lLastRow = 0 Then lLastRow = 1

Set LastCell = wrkSht.Cells(lLastRow, lLastCol)

On Error GoTo 0
End Function