ActiveSheets.Range("").Copy Method

[Peteor]

Ok, so I am working on a macro seen below:

Sub Data_Parse()

Dim ER As Long

ER = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Dim Cell As Range
Dim CriteriaRange As Range


Set CriteriaRange = ThisWorkbook.ActiveSheet.Range("A3:A" & ER)
For Each Cell In CriteriaRange
If InStr(1, Cell.Value, "H04C", vbTextCompare) > 0 Then
Path_Name = Cell.Offset(columnOffset:=5).Value
File_Name = Path_Name & Cell.Value
Workbooks.Open Filename:=File_Name
ActiveSheets.Range("A6:K").Copy
ActiveWorkbook.Close
Workbooks("Example").Activate
Worksheets("Sheet 1").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select.PasteSpecial xlPasteValues, SkipBlanks:=False, Transpose:=True


End If
Next Cell

End Sub



My questions are how do I start the copy from row 6 through all used cells after? I would like to copy A6, B6, C6, etc. and all rows below without copying any information above row 6. Also, How do I paste such that it would start after the last used cell? Any input would be helpful, and Thank you.

 

[MARK858]

First of all I would be surprised if the code you posted doesn't error out in at least 2 places.
Second, is your sheetname really Sheet 1 (with the space?)?

Anyway try the code below (untested)...

Sub Data_Parse()

    Dim ER As Long

    ER = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    Dim Cell As Range
    Dim CriteriaRange As Range

    Set CriteriaRange = ThisWorkbook.ActiveSheet.Range("A3:A" & ER)
    
    For Each Cell In CriteriaRange
        If InStr(1, Cell.Value, "H04C", vbTextCompare) > 0 Then
        
            Path_Name = Cell.Offset(, 5).Value
            File_Name = Path_Name & Cell.Value
            Workbooks.Open Filename:=File_Name
            
            With ActiveSheet.Range("A6:K" & ActiveSheet.Columns("A:K").Find("*", , xlValues, , xlByRows, xlPrevious).Row)
                Workbooks("Example").Worksheets("Sheet 1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
            
            ActiveWorkbook.Close
            
        End If
    Next Cell

End Sub