автоматически копировать строки, содержащие текст в определенном столбце, при вставке в другую книгу

Question

Я пытаюсь написать макрос для копирования данных из формы, затем открыть отдельную книгу и вставить данные в следующую пустую строку.У пользователя есть 21 строка информации, которую он может заполнить, но число фактически заполненных строк будет изменяться день ото дня.

Следующий код работает за исключением того, что при вставке в целевую рабочую книгупустые ячейки обрабатываются так, как будто они содержат данные.Таким образом, я получаю несколько пустых строк между каждым дампом данных.

Как я могу изменить этот код, чтобы скопировать все строки в диапазоне строки 5 - строки 25, которые содержат текст в столбце «I», но игнорируют любыепустые строки в столбце «I»?

Sub Export_Data()
Dim owb As Workbook
Dim sh As Worksheet

Set sh = Sheet1
sh.Range("A5:K25").Copy
Set owb = Workbooks.Open("my_destination_workbook")

owb.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
owb.Close True
End Sub

Answer 1

Спасибо, Рикардо A

Ваш код работал, чтобы перебрать все, но, к сожалению, он все еще собирал пустые строки.Я сделал небольшое изменение и изменил

If sh.Range("A" & i).Value <> 0 Then

на

If sh.Range("A" & i).Value <> "" Then

И теперь он только копирует строки, значения которых введены в столбец I. Поэтому следующий код теперь работает для копированиявсе строки со значением в столбце I, а затем откройте новую книгу и вставьте скопированные строки в следующую пустую строку.

Sub Export_Data()
Dim owb As Workbook
Dim sh As Worksheet

Set sh = Sheet1
Set owb = Workbooks.Open("my_destination_workbook")

For i = 5 To 25 Step 1
    If sh.Range("A" & i).Value <> "" Then
        sh.Range("A" & i & ":K" & i).Copy
        owb.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If
Next

owb.Close True

End Sub

Answer 2

Я использовал метод For Loop, чтобы посмотреть значения в столбце A и пропустить пустые.Есть много способов сделать это, только один.

Sub Export_Data()
    Dim owb As Workbook
    Dim sh As Worksheet
    Dim sRange as Range
    Dim i as Long

    Set sh = Sheet1
    Set owb = Workbooks.Open("my_destination_workbook")

    For i = 5 to 25 Step + 1 'from 5 to 25 because you are checking A5:K25
        'If "A & i" has a value, copy A to Z and paste it at the end on the new workbook
        If sh.Range("A" & i).Value <> 0 Then
            sh.Range("A" & i & ":K" & i).Copy
            owb.Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next
    owb.Close True
End Sub