我每天都能成功使用以下脚本，并且对我来说已经工作了好几年。
此代码包括5个不同的搜索，这些搜索对一个（源）工作表中的 各种范围 （多列）中的数据进行评估，并在非空白单元格中找到值时在该范围内，它将那些找到的值复制到另一个（目标）工作表中的 各种范围 。
源表中的所有5个搜索都是唯一的，并且值被复制到目标表中的5个不同范围。
在不对5种不同的搜索进行任何更改的情况下，我现在想更改代码，以便将数据复制到 到各种范围 ，而不是复制< strong> 到一个单一范围 ，而不必在源工作表中的每个新发现下确定目标工作表中的多个范围。 （i，i2，i3，i4，i5）
在创建连续的数据流（在一个连续的目标范围内）而不是缺少一个更好的术语，装箱数据（在多个目标范围内）方面的任何帮助，将不胜感激
我还想用格式标题将每个搜索分开。
谢谢您的帮助。非常感谢。
Sub Generate_Schedule_Charges()
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
'Generate_RECURRING_Charges_PART_1()
Dim i As Long
Dim ii As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("DataValues")
Set sht2 = wb.Sheets("BEN")
Sheets("BEN").Select
Range("D201:P219").ClearContents
'Find the last row (in column Z) with data in sheet ("DATA&Values"). (LIMIT data to COLUMN Z)
LastRow = sht1.Range("Z10:Z99").Find("*", SearchDirection:=xlPrevious).Row
'Start copying data values in "BEN" starting at ROW "202" (due to other data located above)
ii = 202
'This is the beginning of the loop !!!
'Start at row 8 in DATAVALUES to last row with data
For i = 8 To LastRow
'First activity
'If Not IsEmpty(sht1.Range("Z" & i)) Then
If Not IsEmpty(sht1.Range("Z" & i)) And _
sht1.Range("Z" & i) <> vbNullString And _
sht1.Range("Z" & i) <> 0 Then
sht2.Range("D" & ii) = sht1.Range("X" & i).Value
sht2.Range("P" & ii) = sht1.Range("Z" & i).Value
sht2.Range("K" & ii) = sht1.Range("AB" & i).Value
sht2.Range("M" & ii) = sht1.Range("AD" & i).Value
ii = ii + 1
End If
Next i
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
'Generate_Suite_ADJUSTMENTS_PART_2()
Dim i2 As Long
Dim ii2 As Long
Dim LastRow2 As Long
Dim wb2 As Workbook
Dim sht1a As Worksheet
Dim sht2a As Worksheet
Set wb2 = ThisWorkbook
Set sht1a = wb2.Sheets("DataValues")
Set sht2a = wb2.Sheets("BEN")
Sheets("BEN").Select
Range("D220:P227").ClearContents
'Find the last row (in column BG) with SUITE CHANGE DATA in sheet ("DATA&Values"). (LIMIT data to COLUMN AK)
LastRow2 = sht1a.Range("BG10:BG99").Find("*", SearchDirection:=xlPrevious).Row
'Start copying data values in "BEN" starting at ROW "223" (due to other data located above)
ii2 = 220
'This is the beginning of the loop !!!
'Start at row 8 in DATAVALUES to last row with data
For i2 = 8 To LastRow2
'For i2 = LastRow2 To 13 Step -1 'works from the bottom to the top
'First activity
'If Not IsEmpty(sht1a.Range("BG" & i2)) Then
If Not IsEmpty(sht1a.Range("BG" & i2)) And _
sht1a.Range("BG" & i2) <> vbNullString And _
sht1a.Range("BG" & i2) <> 0 Then
sht2a.Range("D" & ii2) = sht1a.Range("BE" & i2).Value
sht2a.Range("I" & ii2) = sht1a.Range("BG" & i2).Value
sht2a.Range("K" & ii2) = sht1a.Range("BI" & i2).Value
ii2 = ii2 + 1
End If
Next i2
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
'Generate_One_Time_Charges_PART_3()
Dim i3 As Long
Dim ii3 As Long
Dim LastRow3 As Long
Dim wb3 As Workbook
Dim sht1b As Worksheet
Dim sht2b As Worksheet
Set wb3 = ThisWorkbook
Set sht1b = wb3.Sheets("DataValues")
Set sht2b = wb3.Sheets("BEN")
Sheets("BEN").Select
Range("D228:P247").ClearContents
'Find the last row (in column AK) with SUITE CHANE DATA in sheet ("DATA&Values"). (LIMIT data to COLUMN AK)
LastRow3 = sht1b.Range("AK20:AK100").Find("*", SearchDirection:=xlPrevious).Row
'Start copying data values in "BEN" starting at ROW "230" (due to other data located above)
ii3 = 228
'This is the beginning of the loop !!!
'Start at row 8 in DATAVALUES to last row with data
For i3 = 8 To LastRow3
'For i2 = LastRow2 To 13 Step -1 'works from the bottom to the top
'First activity
'If Not IsEmpty(sht1b.Range("AK" & i3)) Then
If Not IsEmpty(sht1b.Range("AK" & i3)) And _
sht1b.Range("AK" & i3) <> vbNullString And _
sht1b.Range("AK" & i3) <> 0 Then
sht2b.Range("D" & ii3) = sht1b.Range("AI" & i3).Value
sht2b.Range("P" & ii3) = sht1b.Range("AK" & i3).Value
sht2b.Range("K" & ii3) = sht1b.Range("AM" & i3).Value
sht2b.Range("M" & ii3) = sht1b.Range("AO" & i3).Value
sht2b.Range("I" & ii3) = sht1b.Range("AP" & i3).Value
ii3 = ii3 + 1
End If
Next i3
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
'Generate_PAYMENTS_PART_4()
Dim i4 As Long
Dim ii4 As Long
Dim LastRow4 As Long
Dim wb4 As Workbook
Dim sht1c As Worksheet
Dim sht2c As Worksheet
Set wb4 = ThisWorkbook
Set sht1c = wb4.Sheets("DataValues")
Set sht2c = wb4.Sheets("BEN")
Sheets("BEN").Select
Range("D245:P250").ClearContents
'Find the last row (in column BR) with SUITE CHANE DATA in sheet ("DATA&Values"). (LIMIT data to COLUMN AV)
LastRow3 = sht1c.Range("BR10:BR99").Find("*", SearchDirection:=xlPrevious).Row
'Start copying data values in "BEN" starting at ROW "252" (due to other data located above)
ii4 = 245
'This is the beginning of the loop !!!
'Start at row 8 in DATAVALUES to last row with data
For i4 = 8 To LastRow3
'For i2 = LastRow2 To 13 Step -1 'works from the bottom to the top
'First activity
'If Not IsEmpty(sht1c.Range("BR" & i4)) Then
If Not IsEmpty(sht1c.Range("BR" & i4)) And _
sht1c.Range("BR" & i4) <> vbNullString And _
sht1c.Range("BR" & i4) <> 0 Then
sht2c.Range("D" & ii4) = sht1c.Range("BP" & i4).Value
sht2c.Range("P" & ii4) = sht1c.Range("BR" & i4).Value
sht2c.Range("K" & ii4) = sht1c.Range("BV" & i4).Value
sht2c.Range("I" & ii4) = sht1c.Range("BT" & i4).Value
sht2c.Range("M" & ii4) = sht1c.Range("BX" & i4).Value
ii4 = ii4 + 1
End If
Next i4
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
'Generate_BEN_NOTES_5()
Dim i5 As Long
Dim ii5 As Long
Dim LastRow5 As Long
Dim wb5 As Workbook
Dim sht1d As Worksheet
Dim sht2d As Worksheet
Set wb5 = ThisWorkbook
Set sht1d = wb5.Sheets("DataValues")
Set sht2d = wb5.Sheets("BEN")
Sheets("BEN").Select
Range("D252:P258").ClearContents
'Find the last row (in column AV) with SUITE CHANE DATA in sheet ("DATA&Values"). (LIMIT data to COLUMN AV)
LastRow5 = sht1d.Range("AV10:AV99").Find("*", SearchDirection:=xlPrevious).Row
'Start copying data values in "BEN" starting at ROW "255" (due to other data located above)
ii5 = 252
'This is the beginning of the loop !!!
'Start at row 8 in DATAVALUES to last row with data
For i5 = 8 To LastRow5
'For i2 = LastRow2 To 13 Step -1 'works from the bottom to the top
'First activity
'If Not IsEmpty(sht1c.Range("AU" & i4)) Then
If Not IsEmpty(sht1d.Range("AU" & i5)) And _
sht1d.Range("AU" & i5) <> vbNullString And _
sht1d.Range("AU" & i5) <> 0 Then
sht2d.Range("D" & ii5) = sht1d.Range("AT" & i5).Value
sht2d.Range("I" & ii5) = sht1d.Range("AV" & i5).Value
'sht2d.Range("K" & ii5) = sht1c.Range("AZ" & i5).Value
ii5 = ii5 + 1
End If
Next i5
End Sub