Question

我想将数据复制到另一个工作表，但是我希望宏确定将数据复制到的下一个空列。因此，从范围C5开始，我希望它确定下一个空列（D5或E5或F5，直到M5）是什么，一旦确定，我希望它从指定的“主要”工作表范围中复制数据下面。我知道列值必须是一个传递给行值的变量，此函数才能起作用，但无法弄清楚该如何做。论坛上有一些样本，但我没有一个能适应。

Sub Copy_To_Borrower_DBase()

Worksheets("Borrower Database").Range("D5").Value = 
Sheets("Main").Range("F5").Value 'Borrower Name
Worksheets("Borrower Database").Range("D6:D8").Value = 
Sheets("Main").Range("G6:G8").Value 'Income, Credit and Car Pmt
Worksheets("Borrower Database").Range("D9:D10").Value = 
Sheets("Main").Range("G11:G12").Value 'Borrower Name
Worksheets("Borrower Database").Range("D11").Value = 
Sheets("Main").Range("G15").Value 'Reserves
Worksheets("Borrower Database").Range("D12").Value = 
Sheets("Main").Range("D15").Value 'Credit Score
Worksheets("Borrower Database").Range("D13").Value = 
Sheets("Main").Range("D14").Value 'Rate
Worksheets("Borrower Database").Range("D14").Value = 
Sheets("Main").Range("C14").Value 'Discount Point
Worksheets("Borrower Database").Range("D15").Value = 
Sheets("Main").Range("D17").Value 'More than 1 Borrower

End Sub

Answer 1

这个问题和数据似乎很难100％匹配，因此很难理解，但是我提供了这个示例来向您展示如何找到下一个免费的列：

Dim sourceSheet as Worksheet
Dim destSheet as Worksheet

Set sourceSheet = Worksheets("source")
Set destSheet = Worksheets("dest")

getNextAvailableColumn(destSheet).Value = sourceSheet.Range("A1").Value
getNextAvailableColumn(destSheet).Resize(sourceSheet.Range("A2:B10").Rows.Count,sourceSheet.Range("A2:B10").Columns.Count).Value = sourceSheet.Range("A2:B10").Value

Function getNextAvailableColumn(ws as Worksheet) as Range

    Dim nextCol as Range
    With destSheet
        nextCol = .cells(1,.Columns.Count).End(xlLeft).Offset(,1)
    End With

    Set getNextAvailableColumn = nextCol

End Function

Answer 2

只需清理代码并添加第一个空列（lCol）。

Sub Copy_To_Borrower_DBase()
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ThisWorkbook.Sheets("Main")
Set ws2 = ThisWorkbook.Sheets("Borrower Database")

Dim lCol As Long

    With ws2
    lCol = .Cells(5, .Columns.Count).End(xlToLeft).Offset(, 1).Column
        .Cells(5, lCol).Value = ws1.Range("F5").Value 'Borrower Name
        .Range(.Cells(6, lCol), .Cells(8, lCol)).Value = ws1.Range("G6:G8").Value 'Income, Credit and Car Pmt
        .Range(.Cells(9, lCol), .Cells(10, lCol)).Value = ws1.Range("G11:G12").Value 'Borrower Name
        .Cells(11, lCol).Value = ws1.Range("G15").Value 'Reserves
        .Cells(12, lCol).Value = ws1.Range("D15").Value 'Credit Score
        .Cells(13, lCol).Value = ws1.Range("D14").Value 'Rate
        .Cells(14, lCol).Value = ws1.Range("C14").Value 'Discount Point
        .Cells(15, lCol).Value = ws1.Range("D17").Value 'More than 1 Borrower
    End With
End Sub

将数据复制到下一个空列

2 个答案: