將單元格從一個工作表復制並重新格式化為另一工作表

Question

我正在整理一系列宏，並且已經達到了我在VBA中的技能極限（僅限於此）。

我有兩張紙，第二張紙依賴於第一張紙的內容。 當前，要求用戶將第一張紙中的內容復制並插入第二張紙中，然后進行操作，可以理解的是，沒有人會這樣做，因為他們要么懶惰要么被嚇倒。

為了使他們更有可能將信息復制到第二張紙上，我想使用一個從按鈕調用的宏。

從本質上講，我需要克服兩個問題，我在祈禱您能為您提供幫助。

1. 要復制的區域不是靜態的，並且需要復制的行數會有所不同； 和
2. 並非復制范圍內的所有列都需要插入到目標表中。

為了解決第一個問題，我知道我需要使用此答案中提供的LastrRow的一些變體： https ://stackoverflow.com/a/11169920/4693144

我已經嘗試過按以下方式使用該代碼，但是它不斷向我踢“錯誤'9'：下標超出范圍”：

Sub CopyBudget()

Dim LastRow As Long
Dim CopyRange As Range
    With Sheets("Project Budget")
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                After:=.Range("A8"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlFormulas, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

    Else
        LastRow = 1
    End If
 End With

 Sheets("Project Plan").Range("D60").Resize(LastRow) = _
            Sheets("Project Budget").Range("A8").Resize(LastRow).Value
                If Not CopyRange Is Nothing Then
                CopyRange.Copy Sheets("Project Plan").Cells(60, "D")
            End If


End Sub

編輯：我很抱歉沒有在最初寫帖子時發布我的錯誤參考（我在工作中沒門了）。 錯誤突出顯示了整個代碼塊：

        LastRow = .Cells.Find(What:="*", _
                After:=.Range("A8"), _
                Lookat:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlFormulas, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

我意識到這段代碼只會復制范圍本身，而不能區分列。 問題是我不確定如何確保復制的行僅包含所需的列。 我是否應該根據連續運行的所需列使用上面代碼的功能版本的幾種變體來獨立復制和插入每列，還是應該只抓住所有列然后使用代碼從復制的列中選擇我想要的列或插入的單元格？

我真的在尋求盡可能多的幫助。

Answer 1

對於僅復制特定列的問題，我認為僅使用范圍會比較困難。

您可以嘗試將所選范圍復制到緩沖紙上，然后將其掃描以刪除無用的列，然后將其復制到最終紙上。 您可以將其用於刪除列：

Sub Column_Delete(ByVal Sheets_Index As Integer, ByVal Str_to_Find As String)

Dim Ws As Worksheet
Set Ws = Worksheets(Sheets_Index)


Dim EndColumn As Integer
EndColumn = Ws.Cells(1, Columns.Count).End(xlToLeft).Column

'descending travel of the columns as we are going to delete some of them
For j = 1 To EndColumn
    If InStr(Ws.Cells(1, EndColumn - j + 1), Str_to_Find) > 0 Then
        Ws.Columns(EndColumn - j + 1).EntireColumn.Delete Shift:=xlToLeft
    End If
Next j

'Don't forget to free Ws (like I did...)
Set Ws = Nothing

End Sub

Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
    ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function

而且要復制粘貼，您不要在給定的代碼中使用范圍，請耐心地說，我經常使用：

    Sub AddDataToAnotherSheet(ByVal DataSheetName As String, ByVal StackSheetName As String)
'
Dim ShIn As Worksheet
Dim ShOut As Worksheet
Set ShIn = ThisWorkbook.Sheets(DataSheetName)
Set ShOut = ThisWorkbook.Sheets(StackSheetName)

'ShIn.Cells(2, 1).End(xlToRight).Column
Dim RgTotalInput As String
Dim RgTotalOutput As String

RgTotalInput = "$A$2:$" & ColLet(ShIn.Cells(1, 1).End(xlToRight).Column) & "$" & ShIn.Cells(Rows.Count, 1).End(xlUp).Row
RgTotalOutput = "$A$" & ShOut.Cells(Rows.Count, 1).End(xlUp).Row + 1

ShIn.Range(RgTotalInput).Copy Destination:=ShOut.Range(RgTotalOutput)


End Sub



Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
    ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function

Answer 2

答：因此，一般而言，如果要移動的是從第一張紙到第二張紙的值（包括由公式計算的結果值，而不是公式本身），則應使用VBA賦值語句復制值，不能剪切粘貼。 對於中等程度的單元格復制，它將更快地工作，您將完全控制要復制的行和列（特別是如果某些行和/或列將不被復制），這對於程序員而言更容易理解。 -fact，易於配置，代碼通常更小，調試也更容易。

因此，如果我們假設您在兩個不同的工作表上預定義了兩個范圍srcRng和destRng，那么您所做的就是在通常兩個嵌套循環內執行以下操作：

destRng.Cells(destRow, destCol).value = srcRng.Cells(srcRow, srcCol).value

您的外部循環通常用於復制的行，內部循環通常用於您要復制的列。 當然，如果僅要復制兩三列，則不要進行內部循環，而只需使用不同的destCol / srcCol對重復上述復制語句兩次或三遍即可。

B.如果確實需要復制公式本身，並且需要公式自動調整它們對其他復制數據的相對引用，那么實際上您被迫使用Excel的剪切和粘貼功能，因為只有那樣才能使用公式相對引用調整。 您要解決的策略是要跳過更多行還是要跳過更多列...如果是所有行（甚至行數是可變的），那么最好選擇並創建列的復制范圍移動跨越所有行。

C.就調試幫助而言，您確實必須告訴我們故障發生在哪條線上。 VBA調試器通過突出顯示代碼行來告訴您哪一行失敗。 最壞的情況只是放在一個斷點，然后逐步執行子例程以找到它。 但實際上，每個在這里提出問題的人都無法提供明顯的必要信息。

D.以下幾行似乎組成不正確。 Cells屬性采用數字值，而不是字符串值。 列“ D”為4。

CopyRange.Copy Sheets("Project Plan").Cells(60, "D")