根据adjecent单元格中的值复制单元格值

时间:2018-02-01 14:32:09

标签: excel vba excel-vba

我有一个漂亮的Excel文件会自动将CSV文件中的值导入我的工作表,数据会粘贴在我工作表的第一个空行中。

问题是数据可能来自3个不同的来源,比如G列填充的是1,a 2或3。

根据所述列中的值,我希望将该行的其他值粘贴到不同工作表中特定范围内的第一个空单元格中。工作表名称取决于C列中的值,我为此创建了以下代码:

Sub Lastcell()
Dim LR As String
Dim SheetName As String
LR = Cells(Rows.Count, "B").End(xlUp).Row
SheetName = Range("C" & LR).Value
If SheetExists(SheetName) Then
    Else
        Sheets.Add(After:=Sheets(Sheets.Count)).name = SheetName
    End If
End Sub

Function SheetExists(SheetName As String, Optional Wb As Workbook) As Boolean
    If Wb Is Nothing Then Set Wb = ThisWorkbook
    On Error Resume Next
    SheetExists = (LCase(Wb.Sheets(SheetName).name) = LCase(SheetName))
    On Error GoTo 0
End Function

所以我知道我正在复制哪个工作表,现在我想选择它去哪一行。

假设,如果G列的最后一个单元格中的值为1,我想将整行复制到C行的第一个空单元格,从C5开始。

如果G列的最后一个单元格中的值是2,我想将整行复制到H行的第一个空单元格,从H5开始。

如果G列的最后一个单元格中的值为3,我想将整行复制到M行的第一个空单元格,从M5开始。

我的问题是:如何根据单元格的值选择不同的粘贴范围。单元格值为1,粘贴到列A中的最后一个空单元格单元格值为2,粘贴到列B中的最后一个空单元格单元格值为3,粘贴到列C中的最后一个空单元格?

1 个答案:

答案 0 :(得分:0)

这样的东西?

Sub tgr()

    Dim wb As Workbook
    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim LR As Long, NR as long
    Dim DestCol As String

    Set wb = ActiveWorkbook
    Set wsData = wb.ActiveSheet
    LR = wsData.Cells(wsData.Rows.Count, "G").End(xlUp).Row

    On Error Resume Next
    Set wsDest = wb.Sheets(wsData.Cells(LR, "C").Value)
    On Error GoTo 0
    If Not wsDest Is Nothing Then
        Select Case wsData.Cells(LR, "G").Value
            Case 1: DestCol = "C"
            Case 2: DestCol = "H"
            Case 3: DestCol = "M"
        End Select

        'Destination sheet and columns are now defined
        'Copy over what you want to the destination
        NR = wsDest.Cells(wsDest.Rows.Count, DestCol).End(xlUp).Row
        If NR < 5 Then NR = 5
        wsDest.Cells(NR, DestCol).Resize(, 6).Value = wsData.Cells(LR, "A").Resize(, 6).Value
    End If

End Sub