VBA正在复制三个单元格的范围并将其保存到另一个文件，我如何让它增加范围

Question

我的VBA代码正在从扫描条形码的扫描仪输入，然后将三段信息输入单元格A1 B1和C1。第一次它工作得很好，然而，在我尝试在下面一行做它不工作。我知道它与我选择的范围有关，但我不知道如何增加范围。这是我到目前为止的代码:

    Private Sub Worksheet_Change(ByVal Target As Range)
Dim String_1 As String
Dim String_2 As String
Dim String_3 As String
String_1 = "400"
String_2 = "401"
String_3 = "402"
If Len(Range("A1").Value) > 0 And Len(Range("B1").Value) > 0 And Len(Range("C1").Value) > 0 Then
Dim sComp As String
sComp = Left(Range("C1"), 3)
 If sComp = String_1 Or sComp = String_2 Or sComp = String_3 Then
    Range("A1:C1").Copy
    Dim wbCopy As Workbook
    Set wbCopy = Workbooks.Add
    With wbCopy
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        .SaveAs Filename:="u:CSVDiepunch" & sComp & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        Application.DisplayAlerts = True
        .Close False
    End With
  End If
End If
End Sub

我需要这个工作，所以每次有一个不同的数字得到触发的字符串之一，正确的数据被保存到正确的文件。有人对如何解决这个问题有什么见解或建议吗?感谢你的帮助。

Answer 1

您需要找到下一个空白行来粘贴数据。

<>之前私有子Worksheet_Change(ByVal目标范围)Dim String_1 As StringDim String_2 As StringDim String_3 As String昏暗的新行一样长String_1 = "400"String_2 = "401"String_3 = "402"如果Len(Range("A1").Value)> 0 And Len(Range("B1").Value)> 0 And Len(Range("C1").Value)> 0将sComp定义为字符串sComp = Left(Range("C1")， 3)如果sComp = String_1或sComp = String_2或sComp = String_3则范围(A1: C1")。复制将wbCopy设置为工作簿设置wbCopy = Workbooks。添加与wbCopynewRow = . range ("A1"). end (xlUp)。第1行.Sheets(1)。Cells(newRow, 1).PasteSpecial xlpastvalues应用程序。DisplayAlerts = False. savea Filename:="u:CSVDiepunch" & sComp & ".csv"， FileFormat:=xlCSV, CreateBackup:=False应用程序。DisplayAlerts = True.Close假结尾如果如果终止子

Answer 2

您必须检查要更新的CSV文件是否存在，并找到它的最后一行以在其后面附加新数据

一个快速和肮脏的修复:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim String_1 As String
    Dim String_2 As String
    Dim String_3 As String
    Dim myFileName As String
    Dim wbCopy As Workbook
    Dim lastRow As Long
    String_1 = "400"
    String_2 = "401"
    String_3 = "402"
    If Len(Range("A1").Value) > 0 And Len(Range("B1").Value) > 0 And Len(Range("C1").Value) > 0 Then
        Dim sComp As String
        sComp = Left(Range("C1"), 3)
        If sComp = String_1 Or sComp = String_2 Or sComp = String_3 Then
'            myFileName = "u:CSVDiepunch" & sComp & ".csv"
            Range("A1:C1").Copy
            Application.ScreenUpdating = False
            If Dir(myFileName) = "" Then
                Set wbCopy = Workbooks.Add
            Else
                Set wbCopy = Workbooks.Open(myFileName)
            End If
            With wbCopy
                With .Sheets(1)
                    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                    If .Cells(lastRow, 1).Value <> "" Then lastRow = lastRow + 1
                    .Cells(lastRow, 1).PasteSpecial xlPasteValues
                End With
                Application.DisplayAlerts = False
                .SaveAs Filename:=myFileName, FileFormat:=xlCSV, CreateBackup:=False
                Application.DisplayAlerts = True
                .Close False
            End With
            Application.ScreenUpdating = True
        End If
    End If
End Sub