不能写入细胞

时间:2015-02-13 21:39:04

标签: excel vba

我正在尝试从工作簿中的每个其他工作表中获取数据并将其粘贴到主工作表(Sheet1)中,但是当我运行我的代码时没有任何反应,有人可以告诉我为什么会这样吗?

Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook

wb.Sheets("Sheet1").Cells(1, 1).Text = "Started"
i = 1
'cells is row,col
For Each objWorksheet In wb.Worksheets
    'ws.Cells(1, i).Value = objWorksheet.Name
    'objWorksheet.Activate
    'ws = wb.ActiveSheet
    doJStuff i, objWorksheet
    i = i + 1
Next
    wb.Sheets("Sheet1").Cells(1, 1).Text = "DONE"
End Sub

Sub doJStuff(row, ws)
    ws.Select
    Range("A2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    ActiveSheet.Cells(row, 1).Select
    ActiveSheet.Paste
'end paste name
'copy post history and transpose into row 2 on sheet1
    ws.Select
    Range("H2:H30").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    ActiveSheet.Cells(row, 2).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
'end post history
End Sub

1 个答案:

答案 0 :(得分:0)

您的代码存在许多问题。首先,尽可能避免使用Select。其次,您没有正确分配变量。您应该将Option Explicit放在模块顶部,然后确保已正确分配内容。

对于实际代码,当你将H2:H30范围复制/粘贴到第一张纸上时,你只会得到除了最后一张之外的每张纸的范围内的第一个值,因为你粘贴了28行但只能将目标行加1。我没有解决这个问题,但值得指出。我也留下了你的评论,虽然它们没有多大意义。在不知道你想要做什么的情况下,我只清理了你的一些代码,但它可能仍然无法正常工作。

Sub YourSub()
Dim wb As Workbook
Dim wksht As Worksheet
Dim i As Integer

Set wb = ActiveWorkbook

wb.Sheets("Sheet1").Cells(1, 1).Text = "Started"
i = 1
'cells is row,col
For Each wksht In Worksheets
    'ws.Cells(1, i).Value = objWorksheet.Name
    'objWorksheet.Activate
    'ws = wb.ActiveSheet
    doJStuff i, wksht
    i = i + 1
Next
    wb.Sheets("Sheet1").Cells(1, 1).Text = "DONE"
End Sub

Sub doJStuff(row As Integer, ws As Worksheet)
    ws.Range("A2").Copy
    Sheets("Sheet1").Cells(row, 1).PasteSpecial
'end paste name
'copy post history and transpose into row 2 on sheet1
    ws.Range("H2:H30").Copy
    Sheets("Sheet1").Cells(row, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
'end post history
End Sub