添加粘贴单元格的名称

时间:2014-01-10 21:56:53

标签: vba excel-vba excel

这可能是每个人都看到过的最简单的请求,但请保持幽默,因为我还是初学者。基本上我正在将多个工作表中的数据剪切并粘贴到一个工作表中。我正在尝试将文本放入B列,以指定粘贴的内容。以下是我到目前为止所做的以及我尝试使用它的地方(见注释):

Option Explicit

Private Sub DoStuff()

Dim ws As Worksheet
Dim summary As Worksheet
Dim rng As Range

Set summary = ThisWorkbook.Sheets("Tab_Upload")

For Each ws In ActiveWorkbook.Worksheets
    If LCase(Left(ws.Name, 1)) = "_" Then
        ws.Range("A23").Copy summary.Range("A" & summary.Range("A" & summary.Rows.Count).End(xlUp).Row + 1)
        ws.Range("H13:S13").Copy summary.Range("A" & summary.Range("A" & summary.Rows.Count).End(xlUp).Row + 1).Offset(-1, 7)
'Place a line here that would say, "Funded Fixed Price Sub" in column B
        ws.Range("A23").Copy summary.Range("A" & summary.Range("A" & summary.Rows.Count).End(xlUp).Row + 1)
        ws.Range("H14:S14").Copy summary.Range("A" & summary.Range("A" & summary.Rows.Count).End(xlUp).Row + 1).Offset(-1, 7)
'Place a line here that would say, "Unfunded Fixed Price Sub" in column B

    End If
Next ws

End Sub

1 个答案:

答案 0 :(得分:0)

很抱歉没有一个完整的答案,因为这已经快到午夜了,我要去睡觉了。

由于您确定每个副本的目标行的方式,您的代码很难理解。你在哪里得到那种技术?

我确定例程开头的下一个空闲行,然后在适当的时候逐步调整行号。没有负的行偏移,所以我总是知道我在哪里。

我认为这段代码符合您的要求。

Option Explicit
Private Sub DoStuff()

  Dim ws As Worksheet
  Dim summary As Worksheet
  Dim RowTabCrnt As Long

  Set summary = ThisWorkbook.Worksheets("Tab_Upload")

  ' Determine next free row in worksheet Tab_UpLoad
  ' Note if worksheet is empty, RowTabCrnt will be set to 2.
  With Worksheets("Tab_Upload")
    RowTabCrnt = .Cells(Rows.Count, "A").End(xlUp).Row + 1
  End With

  For Each ws In ActiveWorkbook.Worksheets
    ' LCase removed because underscore is not affected by LCase
    If Left(ws.Name, 1) = "_" Then

      ws.Range("A23").Copy Destination:=summary.Cells(RowTabCrnt, "A")
      ws.Range("H13:S13").Copy Destination:=summary.Cells(RowTabCrnt, "H")
      summary.Cells(RowTabCrnt, "B").Value = "Funded Fixed Price Sub"

      RowTabCrnt = RowTabCrnt + 1     ' Advance to next row

      ws.Range("A23").Copy Destination:=summary.Cells(RowTabCrnt, "A")
      ws.Range("H14:S14").Copy Destination:=summary.Cells(RowTabCrnt, "H")
      summary.Cells(RowTabCrnt, "B").Value = "Unfunded Fixed Price Sub"

      RowTabCrnt = RowTabCrnt + 1     ' Advance to next row

    End If

  Next ws

End Sub