复制由空白单元格组成的列数据

Question

我遇到的情况是我需要从excel表复制一个范围并将其粘贴到另一个。我做了以下编码，进展顺利......

Dim mpn As String

mpn = Application.InputBox(prompt:="Input the MPN column name:")

mpn1 = mpn

mpn2 = mpn1 & ":" & mpn

Set currentSheet = wbSource.Worksheets(1)

lastRow1 = currentSheet.Range(mpn1).End(xlDown).Row

ThisWorkbook.Sheets("Sheet2").Range("F2:F" & lastRow1) = currentSheet.Range(mpn2 & lastRow1).Value

此编码完全正常，直到列中有任何空白单元格。任何人都可以帮助我解决这个特殊情况。

Answer 1

要复制整列，请使用.Columns()功能引用您的范围。

您可以使用以下内容：

ThisWorkbook.Sheets("Sheet2").Columns("F") = 
    currentSheet.Columns(mpn1).Value

---

另一种方法是使用.Copy子，并为副本指定Destination：

currentSheet.Columns(mpn1).Copy 
    Destination:=ThisWorkbook.Sheets("Sheet2").Columns("F")
Application.CutCopyMode = false

---

此答案假设两个工作簿都使用相同版本的Excel保存。如果一个工作簿是2007年之前，一个是2007+，那么工作表中允许的最大行数将不同。

在这种情况下，复制整个列不是一个选项 - 请查看Siddarth's answer以获得更长时间的复杂解决方案。他检查不同的行数以防止错误。

Answer 2

就像我在上面的评论中提到的，使用.Find来查找列名，而不是提示输入列名。如果用户在输入框中键入Blah Blah怎么办？

同样如评论中所述，使用xlUp而不是xlDown来查找空白单元格的最后一行以及您可能面临的其他问题。见this

这是你在尝试什么？ （的未测试）

我已对代码进行了评论，因此您不应该在理解它时遇到问题。但如果你这样做，那么只需发回：）

Sub Sample()
    Dim mpnCol As Long
    Dim ColName As String, strSearch As String
    Dim aCell As Range
    Dim wbSource As Workbook
    Dim wbInput As Worksheet, currentSheet As Worksheet

    '~~> Change this to the Mpn Header
    strSearch = "MPN"

    '~~> This you have declared in your code
    '~~> Change as applicable
    Set wbSource = "Someworkbook"

    Set currentSheet = wbSource.Worksheets(1)
    Set wbInput = ThisWorkbook.Sheets("Sheet2")

    With currentSheet
        '~~> Search for the mpn header in row 1. Change as applicable
        Set aCell = .Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            '~~> Column Number
            mpnCol = aCell.Column
            '~~> Converting column number to column name
            ColName = Split(.Cells(, mpnCol).Address, "$")(1)
            '~~> Getting last row
            lRow = .Range(ColName & .Rows.Count).End(xlUp).Row

            '~~> Checking for excel versions. Comment this if the copying
            '~~> will always happen in xl2007+ versions
            If lRow > 65536 Then
                MsgBox "Are you trying to copy from xl2007 to xl2003?. The number of rows exceed the row limit"
                Exit Sub
            End If

            wbInput.Range("F2:F" & lRow).Value = .Range(ColName & "2:" & ColName & lRow).Value
        Else
            MsgBox strSearch & " header not found"
        End If
    End With
End Sub