value to next blank in range

[orsm6]

Hi all - i found this code on this site and g
have been trying to manipulate it a little to do what i need. it works, but what i need it to do is put the value in the next blank cell in column A.
There is a grand total cell at the bottom of A and so it puts the data after that.

here is my modified code, but how do i get the values to go to the last cell in A but in the range of A2:A100?

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Const strPath As String = "C:\Users\ETC1944\Desktop\dispo\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("Sheet1").Range("a8:I20").Copy wkbDest.Sheets("2020 disposition tracker").Cells(.Count, "A1", Range("a100").End(xlUp).Offset(1, 0))
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

thanks

 

[Zot]

The line:
LastRow = .Sheets("sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
is not use, right? I don't see you use the LastRow value at all. It can be removed.

Line:
.Sheets("Sheet1").Range("a8:I20").Copy wkbDest.Sheets("2020 disposition tracker").Cells(.Count, "A1", Range("a100").End(xlUp).Offset(1, 0))
is you are copying Sheet1 range A8:I20 and you are trying to copy to next empty row in column A as I understood it.

If you want to go to last cell in range A2:A100, then it should be
wkbDest.Sheets("2020 disposition tracker").Cells(101, "A").End(xlUp).Offset(1, 0)

I use 101 since the last cell could be 100.

Try if this code works to your need. I have not tested it

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\ETC1944\Desktop\dispo\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("Sheet1").Range("a8:I20").Copy wkbDest.Sheets("2020 disposition tracker").Cells(101, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[orsm6]

The line:
LastRow = .Sheets("sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
is not use, right? I don't see you use the LastRow value at all. It can be removed.

Line:
.Sheets("Sheet1").Range("a8:I20").Copy wkbDest.Sheets("2020 disposition tracker").Cells(.Count, "A1", Range("a100").End(xlUp).Offset(1, 0))
is you are copying Sheet1 range A8:I20 and you are trying to copy to next empty row in column A as I understood it.

If you want to go to last cell in range A2:A100, then it should be
wkbDest.Sheets("2020 disposition tracker").Cells(101, "A").End(xlUp).Offset(1, 0)

I use 101 since the last cell could be 100.

Try if this code works to your need. I have not tested it

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\ETC1944\Desktop\dispo\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("Sheet1").Range("a8:I20").Copy wkbDest.Sheets("2020 disposition tracker").Cells(101, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

that is perfect, thanks very much Zot