首页 > 解决方案 > 使用来自另一个工作表的 500 多个列标题填充工作表的单元格

问题描述

我需要在名为“Main”的工作表上填充单元格 A1 到 Z1,然后从 A2 到 Z2 填充名为“PPL”的工作表中第 1 行中的标题值。列数是可变的,但将是 500+。

    Sub Button1_Click()
    On Error GoTo Err_Button1

    Dim SourceCol As Integer, DestCol As Integer, DestRow As Integer
    SourceCol = 1
    DestCol = 1
    DestRow = 1

    Do Until IsEmpty(Worksheets("PPL").Cells(1, SourceCol))
    Do Until DestCol = 26
    Worksheets("Main").Select
    Worksheets("Main").Cells(DestRow, DestCol).Value = Strip(Worksheets("PPL").Cells(1, SourceCol).Value)
    DestCol = DestCol + 1
    SourceCol = SourceCol + 1
    Loop
    DestCol = 1
    DestRow = DestRow + 1
    Loop
    Exit Sub

Err_Button1:
    MsgBox Err.Description, vbCritical, Err.Number

End Sub
Private Function Strip(Value As String) As String
    Strip = Replace(Value, "_", " ")
End Function

标签: excelvba

解决方案


Scotts 的回答是一个很好的公式,这是一个基本的 VBA 示例:代码中的注释,根据需要更新工作表名称

复制以下代码并粘贴到 Visual Basic 编辑器窗口中

Sub SplitRowIntoMultipleRows()

Dim srcews As Worksheet, destws As Worksheet, lCol As Long, i As Long 'Declare the variables

    'Assign your variables
    Set srcews = ThisWorkbook.Sheets("Part")
    Set destws = ThisWorkbook.Sheets("Main")

    lCol = srcews.Cells(1, Columns.Count).End(xlToLeft).Column

    x = 1 'increment the rows in the destws 'Loop thru the row 1 in the srcews incrementing every 26 cells

        For i = 1 To lCol Step 26 

           'Copy every 26 cells in row 1 of the srcews and paste to the destws,
           'starting in Cells(1,1), and stepping to the next row for each loop 

           srcews.Cells(1, i).Resize(, 26).Copy destws.Cells(x, 1)

           x = x + 1 'add 1 to start on the next row in the destws

        Next i 'loop to the next cel, whic would be `Cells(1, 27)`, etc.
    End Sub

推荐阅读