Скопируйте используемый диапазон из листа 1 и вставьте в лист 3

#excel #vba

#excel #vba

Вопрос:

Я пытался создать код, который копирует UsedRange из Sheet1 и вставляет этот диапазон Sheet3 .

При запуске код каждый раз UsedRange будет вставляться в Sheet3 первую пустую строку.

Например: в with data есть 5 строк (1-я строка всегда будет заголовком) Sheet1 , я нажму run, код скопирует и вставит данные Sheet3 Row2 (1-я строка всегда будет заголовком).

Итак, теперь Sheet3 у меня есть данные, пока Row5 я снова не нажму кнопку запуска, после чего данные будут вставлены Row6 .

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

Мы будем очень признательны за вашу помощь.

Код.

 Sub usedrange()

    Dim ws1         As Worksheet
    Dim ws2         As Worksheet
    Dim source      As Range
    Dim target      As Range
    Dim lastColumn  As Long

    Set ws1 = Worksheets("NewSheet")
    Set ws2 = Sheet3

    With ws2
        lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        If WorksheetFunction.CountA(.Rows(1)) > 0 Then
            lastrow = lastrow   1
        End If
    End With

    Set source = ws1.usedrange.Offset(1)
    Set target = ws2.Cells(, lastrow)

    source.Copy Destination:=target
    Application.CutCopyMode = False

End Sub
 

Ответ №1:

Скопируйте используемый диапазон

 Option Explicit

Sub copyUsedRange()

    Dim ws1         As Worksheet
    Dim ws2         As Worksheet
    Dim Source      As Range
    Dim Target      As Range
    Dim LastRow     As Long
    
    ' Code names
    Set ws1 = Sheet1
    Set ws2 = Sheet3
    ' Tab Names
    'Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    'Set ws2 = ThisWorkbook.Worksheets("Sheet3")
    
    With ws1.UsedRange
        Set Source = .Resize(.Rows.Count - 1).Offset(1)
    End With
    
    With ws2
        Set Target = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
    End With
 
    Source.Copy Target

End Sub
 

Комментарии:

1. Большое вам спасибо @VBasic2008 я был поражен, увидев ответ экспертов. Вы, ребята, молодцы. Спасибо за помощь.

Ответ №2:

Код не требует пояснений

 Public Sub CopyUsedRange()

    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("sourceSheetName")
    
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets("targetSheetName")

    Dim sourceRange As Range
    Set sourceRange = sourceSheet.UsedRange.Resize(sourceSheet.UsedRange.Rows.Count - 1, sourceSheet.UsedRange.Columns.Count).Offset(1)
    
    Dim targetLastRow As Long
    targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    Dim targetRange As Range
    Set targetRange = targetSheet.Range("A" amp; targetLastRow   1)
    
    sourceRange.Copy targetRange
    
End Sub
 

Ответ №3:

 Sub usedrange()

    Dim ws1         As Worksheet
    Dim ws2         As Worksheet
    Dim source      As Range
    Dim target      As Range
    Dim vDB As Variant
    Dim rngDB As Range
    Dim r As Long, c As Long

    Set ws1 = Worksheets("NewSheet")
    Set ws2 = Sheet3
    
    With ws1
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        Set rngDB = .Range("a1", .Cells(r, c))
    End With
    Set source = rngDB.Offset(1)
    vDB = source
    Set target = ws2.Range("a" amp; Rows.Count).End(xlUp)(2)

    target.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB

End Sub
 

Комментарии:

1. @Mento, ты заслуживаешь ответов от многих людей. Вы хорошо задаете вопросы и немедленно отвечаете на вопросы. хорошо.

2. Спасибо @Dy.Lee