Multiple cells selecting and copying to a single row on another worksheet

问题

I've been looking around for this for the past couple days and can't seem to find anything to help me accomplish what I'm trying to do.

I have a sheet that contains data in multiple cells that a user inputs - I would like for when the user hits the submit button that a VBA Macro would copy the data from the multiple cells and paste it into another worksheet on a single row (last row) so I can pull that data later and make changes to it if needed. The worksheet has a unique ID on the top and when searched with that I could pull the data back to the worksheet and make edits to it and save it again.

When I record a Macro and try to multiple select it doesn't let me copy but this is the code that is supplies for the select

Sub Copy()
'
' Copy Macro
'

    Union(Range( _
        "J22:K22,M22,I24:J24,K24:L24,M24,I26:J26,K26:L26,M26,B29:D29,E29:G29,B30:D30,B31:D31,B33:D33,E33:G33,I29,J29:K29,M29,I31:J31,K31:L31,M31,I33:J33,K33:L33,M33,B36:D36,B37:D37,B38:D38,E36:G36,B40:D40,E40:G40,I36,J36:K36,M36" _
        ), Range( _
        "I38:J38,K38:L38,M38,I40:J40,K40:L40,M40,B2:F3,B2:F3,B6:E6,F7:G7,B7:E7,B8:E8,B9:E9,B11:C11,D11:E11,B13:C13,D13:E13,I3:L3,L2,M1,I6:L6,I7:L7,I8:L8,I9:L9,M7,I11:J11,K11:L11,I13:J13,K13:L13,B15:M16,B18:M19,B22:D22" _
        ), Range("B23:D23,B24:D24,E22:G22,B26:D26,E26:G26,I22")).Select

End Sub

This is all the cells I need to copy over and paste to a "Entries" Worksheet in the same workbook. I'm sure someone has asked this before but I'm not sure I'm not using the right key words to search but I'm not finding anything. Allot of stuff to copying multiple row and columns and pasting but nothing for multiple cells.

回答1:

I think this is what you're trying to do

Sub test()
Dim rng As Range
Set rng = Union(Range( _
        "J22:K22,M22,I24:J24,K24:L24,M24,I26:J26,K26:L26,M26,B29:D29,E29:G29,B30:D30,B31:D31,B33:D33,E33:G33,I29,J29:K29,M29,I31:J31,K31:L31,M31,I33:J33,K33:L33,M33,B36:D36,B37:D37,B38:D38,E36:G36,B40:D40,E40:G40,I36,J36:K36,M36" _
        ), Range( _
        "I38:J38,K38:L38,M38,I40:J40,K40:L40,M40,B2:F3,B2:F3,B6:E6,F7:G7,B7:E7,B8:E8,B9:E9,B11:C11,D11:E11,B13:C13,D13:E13,I3:L3,L2,M1,I6:L6,I7:L7,I8:L8,I9:L9,M7,I11:J11,K11:L11,I13:J13,K13:L13,B15:M16,B18:M19,B22:D22" _
        ), Range("B23:D23,B24:D24,E22:G22,B26:D26,E26:G26,I22"))

Dim WSEntries As Worksheet
Set WSEntries = Sheets("Entries")

Dim lastrow As Integer
lastrow = WSEntries.Cells(Rows.Count, "A").End(xlUp).Row

Dim i As Integer
i = 1
For Each c In rng
    WSEntries.Cells(lastrow + 1, i) = c
    i = i + 1
Next


End Sub

It will iterate through your range left to right from top to bottom.

Are you sure you want to use unionkb though? ~~You could just set your range as all the cells~~ I think it used a union due to the character limit of a function. Did you mean to use intersect kb?

To be clear you're working with three ranges here -

Range("J22:K22,M22,I24:J24,K24:L24,M24,I26:J26,K26:L26,M26,B29:D29,E29:G29,B30:D30,B31:D31,B33:D33,E33:G33,I29,J29:K29,M29,I31:J31,K31:L31,M31,I33:J33,K33:L33,M33,B36:D36,B37:D37,B38:D38,E36:G36,B40:D40,E40:G40,I36,J36:K36,M36")

Range("I38:J38,K38:L38,M38,I40:J40,K40:L40,M40,B2:F3,B2:F3,B6:E6,F7:G7,B7:E7,B8:E8,B9:E9,B11:C11,D11:E11,B13:C13,D13:E13,I3:L3,L2,M1,I6:L6,I7:L7,I8:L8,I9:L9,M7,I11:J11,K11:L11,I13:J13,K13:L13,B15:M16,B18:M19,B22:D22")

Range("B23:D23,B24:D24,E22:G22,B26:D26,E26:G26,I22")

No cells intersect all three ranges.

B2:F3 is twice listed in the second range. Otherwise I don't see any overlap.

来源：https://stackoverflow.com/questions/31412847/multiple-cells-selecting-and-copying-to-a-single-row-on-another-worksheet

标签

excel

vba

excel-vba