时间戳

首页 > 解决方案 > Copy data to sheet named in column header and cell named at beginning of row, then loop

excel - Copy data to sheet named in column header and cell named at beginning of row, then loop

问题描述

I have some production data in a table on my Source worksheet. In the header of each column is the name of the Destination worksheet, where the data in that column is to be pasted. In Column A at the beginning of each row is the destination column on the destination worksheet; and in Column B is the destination row. Column C concatenates the two to display the cell name, e.g, T138, which would be the destination cell on the destination worksheets. I haven't been a member long enough to embed an image in this post, but there is an pic of the table here:

1

So each datum on the Source worksheet is to be copied and then pasted to the worksheet named in the column header and the cell named in column C at the beginning of the row (or alternatively, in the column named in Col.A and the row named in Col.B) Then the script should loop back through the rest of the data cells and do the same for each of them: copy data, paste to sheet specified in column header and cell specified at the beginning of the row in Col.C.

Even though I am a total beginner, I actually thought this would be a fairly simple matter. But I haven't been able to figure out how to do this. I've tried various scripts, but none of them even began to do the job, and they really aren't even worth displaying here. I was hoping someone could point me in the right direction. Worse yet, none of my extensive searches have turned up anything like what I want to do. Maybe I just haven't used the right search terms. "Variable" seems to have gotten the closest to useable search results, but not exactly.

Here is an image of what one of the destination sheets looks like, in relevant part:

2

Here's a better image:

3

标签： excelvba

解决方案

This code will Loop over each cell in the range of G3 to J and LastRow. Copying the cell if it's numeric to the sheet based on the column header and the cell from column C.

Public Sub MoveData()
Dim rcell As Range, rng As Range

LastRow = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row - 1
'MsgBox LastRow

Set rng = Application.ActiveSheet.Range("G3:J" & LastRow)

For Each rcell In rng.Cells
    If Not Len(rcell.Value) = 0 Then

        'MsgBox rcell.Value
        Header = rcell.Offset(1 - rcell.Row).Value
        'MsgBox Header
        Set DestSheet = ThisWorkbook.Sheets(Header)
        Set DestCell = ActiveSheet.Range("C" & rcell.Row)
        'MsgBox DestCell
        
        Application.ActiveSheet.Range(rcell.Address).Copy Destination:=Sheets(Header).Range(DestCell)
    End If
Next rcell

End Sub

推荐阅读