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:\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