用于选择特定单元格的VBA代码并相应地粘贴

时间:2014-09-30 19:23:27

标签: excel vba excel-vba

我想从Excel工作簿中的所有工作表中选择特定单元格,然后粘贴到主工作表中。问题是我没有从创建的代码中得到它,我得到一个错误,但是如果我现在离开它(如下所示)我得到它为特定的单元格然后我必须进入代码来更改单元格我希望它输出到哪里。我提前为我的天真道歉。

现在就是

Sub CopyIt()
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Masters" Then
            ws.Range("B18").Copy Sheets("Masters").Cells(Rows.Count, "Q").End(xlUp).Offset(1)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

我希望将此单元格范围"B2-B18"复制到"A:Q"和主工作表中。因此,B2中的值会转到A列,依此类推,然后最后B18转到Q

我没有做什么让代码做它应该做的事情?

4 个答案:

答案 0 :(得分:1)

嘿,我刚测试了这个,它应该为你做的伎俩

Sub CopyIt()

Dim pasteRow As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False

pasteRow = 2

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Masters" Then
        ws.Range("B2", "B18").Copy
        Sheets("Masters").Range("A" & pasteRow).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

        pasteRow = pasteRow + 1
    End If

Next

Application.ScreenUpdating = True
End Sub

这将为每个工作表前进一行,以便您可以根据需要添加任意数量的工作表。请注意,这实际上并不是最通用的代码,您需要将ws.Range("B2", "B18").copy更改为可以选择比赛的内容,列中的所有范围,或者每次要更改时都必须手动扩展范围它

答案 1 :(得分:0)

尝试:

ws.Range("B1:B18").Copy 
Sheets("Masters").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

那应该复制B1:B18,将它从列转换为行并将其粘贴到Masters表的A列的最后一行。

答案 2 :(得分:0)

启用开发者工具栏
选择录制宏
选择b2:b18在一张纸中选择另一张纸并右键单击粘贴特殊全部并选择转置
停止录制宏 现在编辑宏以满足您的要求

示例宏自动生成代码如下

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B2:B18").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

答案 3 :(得分:0)

这应该做的要求...... (这会将每个工作表中的B2:B18单元格中的粘贴值复制到工作表中的不同行&#34; Masters&#34;)

Sub Macro1()

Dim ws As Worksheet
Dim row_count As Integer
row_count = 1

For Each ws In ActiveWorkbook.Worksheets
    MsgBox ws.name
    If ws.name <> "Masters" Then
        ws.Activate
        Range("B2:B18").Select
        Selection.Copy
        Sheets("Masters").Activate
        Range("A" & row_count).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Application.CutCopyMode = False
        row_count = row_count + 1
    End If
Next

End Sub