Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
258 views
in Technique[技术] by (71.8m points)

excel - Range.End with blanks VBA

I am trying to create a dynamic range that will bring back all results from a fixed set of cells, unfortunately I'm having trouble with the Range.End method since there are blanks in between. For Example there may be no values in A8:A10 but it may start on A11 and that row will have data in it. All the tables will be different but it's fixed to the cell range below.

I also saw Range.Find but I could not get that to work either.

The cell range is: A8:F18

lastRow = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1

ThisWorkbook.Worksheets("Sheet2").Range("B" & lastRow).Formula = _
    Source.Worksheets("SUMMARY DATA SHEET").Range("A8").Value
ThisWorkbook.Worksheets("Sheet2").Range("D" & lastRow).Formula = _
    Source.Worksheets("SUMMARY DATA SHEET").Range("D8").Value
ThisWorkbook.Worksheets("Sheet2").Range("A" & lastRow).Formula = _
    Source.Worksheets("SUMMARY DATA SHEET").Range("B4").Value
ThisWorkbook.Worksheets("Sheet2").Range("E" & lastRow).Formula = _
    Source.Worksheets("SUMMARY DATA SHEET").Range("F8").Value
ThisWorkbook.Worksheets("Sheet2").Range("C" & lastRow).Formula = _
    Source.Worksheets("SUMMARY DATA SHEET").Range("E8").Value

       A     B     C       D        E         F           
10  vendor1 ACH vendor1  500.00     XXX 0118-CLIENT-XLIVES
11  vendor2 ACH vendor2  600.00     XX  0118-CLIENT-XLIVES
12  vendor3 ACH vendor3  400.00     XX  0118-CLIENT-XLIVES
13  vendor4 ACH vendor4  $900.00    XXX  0118-CLIENT-XLIVES
14  vendor5 ACH vendor5  $6,000.00   0118-CLIENT-XLIVES
15  vendor6 ACH vendor6  $800.00         0118-CLIENT-XLIVES
16  vendor7 ACH vendor7  $88,000.00      0118-CLIENT-XLIVES
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

It sounds like you need to find the first row with data in the Range("A8:A18"), if that assumption is correct, then this is an example:

Sub foo()
Dim Source As Workbook
Dim wsTarget As Worksheet, wsSource As Worksheet
Dim sourceRange As Range
Dim targetLastRow As Long, sourceFirstRow As Long
Set Source = ThisWorkbook ' ### MODIFY AS NEEDED

Set wsSource = Source.Worksheets("Sheet1") '#Source.Worksheets("SUMMARY DATA SHEET")
Set sourceRange = wsSource.Range("A8:A18")
sourceFirstRow = sourceRange.Find("*", After:=wsSource.Range("A8")).Row

Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
targetLastRow = wsTarget.Cells(Rows.Count, 2).End(xlUp).Row + 1

wsTarget.Range("B" & targetLastRow).Value = _
    wsSource.Range("A" & sourceFirstRow).Value

wsTarget.Range("D" & targetLastRow).Value = _
    wsSource.Range("D" & sourceFirstRow).Value

' etc...

End Sub

If you want to transfer the values from all cells in rows 8-18 that have data, also assuming that every row after the first row has data, then I think you just need to modify sourceRange and make some change to the target using Resize:

Sub foo()
Dim Source As Workbook
Dim wsTarget As Worksheet, wsSource As Worksheet
Dim sourceRange As Range
Dim targetLastRow As Long, sourceFirstRow As Long
Set Source = ThisWorkbook ' ### MODIFY AS NEEDED

Set wsSource = Source.Worksheets("Sheet1") '#Source.Worksheets("SUMMARY DATA SHEET")
Set sourceRange = wsSource.Range("A8:A18")
sourceFirstRow = sourceRange.Find("*", After:=wsSource.Range("A8")).Row
Set sourceRange = wsSource.Range("A" & sourceFirstRow & ":A18")
Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
targetLastRow = wsTarget.Cells(Rows.Count, 2).End(xlUp).Row + 1

wsTarget.Range("B" & targetLastRow).Resize(sourceRange.Rows.Count, 1).Value = _
    sourceRange.Value

wsTarget.Range("D" & targetLastRow).Resize(sourceRange.Rows.Count, 1).Value = _
    sourceRange.Offset(, 3).Value

'etc...
End Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...