0

我是 vba 的新手，正在为宏而苦苦挣扎。

我录制了一个宏，然后尝试对其进行调整。

我所拥有的是一个驱动程序列表，作为当前 c1:t1 的标头，但是当我添加或删除驱动程序时，我需要下面的选择来适应。

B2 是一个合并的单元格 (B2:B5)，其中包含日期，并且跨列仍然是单个单元格。

日期在一年中的每一天都以相同的格式一直重复。

我要做的是选择一个日期并按 ctrl+q 并将标题中的驱动程序名称列表复制到 A 列中的新工作表中，并选择日期和列数以匹配驱动程序的数量标题。

Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+q
'

    Selection.Copy
    Sheets("Daily").Select
    Range("C4:F4").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False



    Application.CutCopyMode = False
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

        Sheets("Weekly").Select
        Range("c1", Range("CV1").End(xlToLeft)).Select
        Selection.Copy
        Sheets("Daily").Select
        Range("A5").Select
        ActiveWindow.SmallScroll Down:=-27
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
    Application.CutCopyMode = False
    Sheets("Weekly").Select
    Application.CutCopyMode = False

        Sheets("Daily").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    Selection.ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Selection.ClearComments
    Sheets("Weekly").Select
    Application.CutCopyMode = False
End Sub

每周 日常的

4

1 回答 1

0 
Dim lCol As Long, cpycel As Range
Set cpycel = Range(ActiveCell.Address)
lCol = (Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column) - 1
cpycel.Resize(4, lCol).Select

Selection.Copy
Sheets("Daily").Select
Range("C4:F4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Application.CutCopyMode = False

Sheets("Weekly").Select
Range(Cells(1, 2), Cells(1, (lCol + 1))).Select
Selection.Copy
Sheets("Daily").Select
Range("a4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Application.CutCopyMode = False

Range(Cells(5, 1), Cells((lCol + 3), 6)).Select
于 2013-09-30T17:51:00.453 回答