VBA正在複製三個單元格的範圍並將其保存到另一個文件中我如何獲得它以增加範圍

Question

我的VBA代碼是掃描條形碼的掃描器的feed輸入，然後將三條信息輸入到單元格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:\CSV\Diepunch" & sComp & ".csv", FileFormat:=xlCSV, CreateBackup:=False 
     Application.DisplayAlerts = True 
     .Close False 

    End With 

    End If 

End If 

End Sub 

我需要這個每次有通過正確的數據被保存到正確的文件中的字符串的一個越來越引發了不同數量的時間來工作，所以。任何人都有如何解決這個問題或提示的見解？感謝幫助。

Answer 1

您需要找到下一個空行來粘貼數據。

 
Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim String_1 As String 
    Dim String_2 As String 
    Dim String_3 As String 
    Dim newRow 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 

      Range("A1:C1").Copy 
      Dim wbCopy As Workbook 
      Set wbCopy = Workbooks.Add 

      With wbCopy 
       newRow = .Range("A1").End(xlUp).Row + 1 
       .Sheets(1).Cells(newRow, 1).PasteSpecial xlPasteValues 
       Application.DisplayAlerts = False 
       .SaveAs Filename:="u:\CSV\Diepunch" & sComp & ".csv", FileFormat:=xlCSV, CreateBackup:=False 
       Application.DisplayAlerts = True 
       .Close False 

      End With 

     End If 

    End If 

End Sub 

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:\CSV\Diepunch" & 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