Question

嗯，我想这可能是一个愚蠢的问题，但我无法自己解决问题。

我有一个包含各种宏的WB。一个用于复制模板（每次必要时创建新的WS）用户填写。之后，一个用于将结果复制到“摘要”的宏。 WS，然后另一个应用公式，之后，应用分数（好，坏，好）和最后一个复制scpecifics单元格格式，以给出适当的格式打印它。

最后一个表现得很奇怪。我创建了40多个WS（包含模板），但格式化在第25行停止。我不知道为什么。

我已经使用公式复制到最后一行，但没有任何东西可以使这个东西工作。

Bellow跟随结果和代码。我认为问题可能是我在一个sub中压缩了所有命令，所以我在variuos中打破它并创建一个＆＃39;触发器＆＃39;按钮激活所有这些命令。

如果没有我的解释，请询问更多信息。

事先，感谢所有的帮助！

Erro on the formatting

我使用的代码。

==============

Sub FormatarCab()

Dim sht As Worksheet
Dim LastRow As Long

Set sht = ActiveSheet

'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row

'Para o cabeçalho
Worksheets("Descritivo").Range("B50").Copy
Worksheets("Avaliação Todos").Range("A1:E1").PasteSpecial xlPasteFormats

Application.CutCopyMode = False
End Sub

＆＃39; -------------------------------------

Sub FormatarNome()

Dim sht As Worksheet
Dim LastRow As Long

Set sht = ActiveSheet

'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row

'Para os Nomes das Abas
Worksheets("Descritivo").Range("B52").Copy
Worksheets("Avaliação Todos").Range("A2:A" & LastRow).PasteSpecial xlPasteFormats


Application.CutCopyMode = False
End Sub

＆＃39; -------------------------------------

Sub FormatarConceito()

Dim sht As Worksheet
Dim LastRow As Long

Set sht = ActiveSheet

'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row

'Para o Conceito
Worksheets("Descritivo").Range("B54").Copy
Worksheets("Avaliação Todos").Range("E2:E" & LastRow).PasteSpecial xlPasteFormats


Application.CutCopyMode = False
End Sub

＆＃39; -------------------------------------

Sub FormatarValores()

Dim sht As Worksheet
Dim LastRow As Long

Set sht = ActiveSheet

'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row

'Para os valoreso
Worksheets("Descritivo").Range("B56").Copy
Worksheets("Avaliação Todos").Range("B2:D" & LastRow).PasteSpecial xlPasteFormats


Application.CutCopyMode = False
End Sub

==============

函数LastRow的结构

==============

Option Explicit

'Common Functions required for all routines:

Function LastRow(Sh As Worksheet)
    On Error Resume Next
    LastRow = Sh.Cells.Find(What:="*", _
                            After:=Sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            searchdirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(Sh As Worksheet)
    On Error Resume Next
    LastCol = Sh.Cells.Find(What:="*", _
                            After:=Sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            searchdirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

==============

Answer 1

忽略您添加到代码底部但实际上没有使用的LastRow函数，您将设置一个名为LastRow的变量，其值为{{1}中找到的最低单元格} - sht到Set。

然后，您可以从ActiveSheet粘贴到E2＆amp; LastRow - 但不一定是E - 事实上你在ActiveSheet

上执行此操作

您希望Worksheets("Avaliação Todos")基于您要粘贴的工作表的最下一行 - 它应如下所示：

LastRow

Answer 2

如果您要查找最后一行或列，可以使用以下内容：

Dim lc As Long
Dim lr As Long

'Change the 1 to whatever row you would want to be able to check for the last true column.
lc = Cells(1, Columns.Count).End(xlToLeft).Column 'determines total number of columns

'Change the "A" to whatever row would show the last row and be consistent for all your worksheets
lr = Range("A" & Rows.Count).End(xlUp).Row 'determines total number of rows including header

以上假设您拥有一致的数据

用于格式化的VBA在特定范围内停止

2 个答案: