VBA 循环：复制/粘贴目标偏移量

Question

首先感谢您的帮助。我需要复制/粘贴数据。接下来是这个想法：根据 sheet AAA 中的单元格内容，我想将数据复制/粘贴到相应的 sheet（如果 XXX 则为 XXX，如果 ZZZ 则为 ZZZ）。我的宏有效但问题是我有一个抵消困扰着我。想象一下，第一圈将数据粘贴到 XXX，但第二圈将复制到 ZZZ，在这种情况下我有一个问题，因为它会将粘贴复制到第三个单元格 (3,1) 而单元格 (2,1)是空的

Sub CopyPastingMyDate()
Dim i As Long
Dim lrow As Long
Dim lcol As Long
Dim RngOne As Range
Dim RngTwo As Range
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("AAA")
lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
lcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
Set RngOne = ws.Range(ws.Cells(lrow, 1), ws.Cells(1, lcol))

For i = 2 To lrow
    Set RngOne = ws.Range(ws.Cells(lrow, 1), ws.Cells(1, lcol))
    If ws.Cells(i, 1) = "XXX" Then
        Set RngTwo = ThisWorkbook.Worksheets("SheetXXX").Range(ThisWorkbook.Worksheets("SheetXXX").Cells(i, 1), ThisWorkbook.Worksheets("SheetXXX").Cells(i, lcol))
        RngOne.Copy
        RngTwo.PasteSpecial xlAll
    End If
    
    If ws.Cells(i, 1) = "ZZZ" Then
        Set RngTwo = ThisWorkbook.Worksheets("SheetZZZ").Range(ThisWorkbook.Worksheets("SheetZZZ").Cells(i, 1), ThisWorkbook.Worksheets("SheetZZZ").Cells(i, lcol))
        RngOne.Copy
        RngTwo.PasteSpecial xlAll
    End If
Next i

End Sub

请问如何解决？我想从第一个可用单元格复制粘贴到。感谢大家。贾娜

Answer 1

试试这个。不过，我可能误解了您要复制的内容：我假设每一行都需要复制到正确的 sheet?

Sub CopyPastingMyDate()
    Dim i As Long
    Dim lrow As Long
    Dim lcol As Long
    Dim RngOne As Range
    Dim RngTwo As Range
    Dim ws As Worksheet, dest, wsDest As Worksheet
    
    Set ws = ThisWorkbook.Worksheets("AAA")
    lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    lcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    Set RngOne = ws.Range(ws.Cells(lrow, 1), ws.Cells(1, lcol))
    
    For i = 2 To lrow
        Select Case ws.Cells(i, 1).Value   'which destination sheet?
            Case "XXX": dest = "SheetXXX"
            Case "ZZZ": dest = "SheetZZZ"
            Case Else: dest = ""
        End Select
        
        If Len(dest) > 0 Then
            ws.Cells(i, 1).Resize(1, lcol).Copy 'copy the row
            Set wsDest = ThisWorkbook.Worksheets(dest)
            wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlAll
        End If
    Next i

End Sub

Answer 2

我找到了一种方法来解决我的问题，方法是引入一个新变量 x = last_row + 1 。我将 RngTwo 中的 i 替换为 x .

VBA 循环：复制/粘贴目标偏移量

VBA Loop : Copy / Paste destination offsetting

excel

vba

loops

copy

row