Run Time Error '1004': Select method of Range Class failed VBA

[jcgonzales]

Run Time Error '1004': Select method of Range Class failed VBA



Hi everyone! I'm new in this community and I'm very glad to form part of it. First of all, I consider I am an intermediate user of VBA so I have a certain level of skill working with it. However, I am in trouble with this work I have to do because I don't get to accomplish my goal of running it.

First I will explain what my purpose is about.

I have a lot of workbooks, each with a code as a name, for example, one workbook is "2014T1AH54". where "2014" is the year "T1" is the first trimester (this could be T2 T3 or T4), "AH" is something that is not going to change and "54" represents a number which will vary from 1 to 180.

This workbooks have only one sheet (sheet 1) and each one contains information in tables which I have to extract of and place it in my workbook called "registro".

I have already achieved to extract the information from one workbook. However I get trouble when I have to extract of all these workbooks at the same time. The point is that the information in the table of each workbook must be placed if the table of my workbook "registro" is empty. In other words, I have to paste the content of the table going down. For example, once I copied the information of the table of 2014T1AH54 in the workbook registro table, then the next line of it will serve as the first place to enter the other table information of the workbook called 2014T2AH54, then going down I will copy the information of 2014T3AH54 and so on. I have my code here and this is:

Function FileOrDirExists(PathName As String) As Boolean
     'Macro Purpose: Function returns TRUE if the specified file
     '               or folder exists, false if not.
     'PathName     : Supports Windows mapped drives or UNC
     '             : Supports Macintosh paths
     'File usage   : Provide full file path and extension
     'Folder usage : Provide full folder path
     '               Accepts with/without trailing "\" (Windows)
     '               Accepts with/without trailing ":" (Macintosh)
     
    Dim iTemp As Integer
     
     'Ignore errors to allow for error evaluation
    On Error Resume Next
    iTemp = GetAttr(PathName)
     
     'Check if error exists and set response appropriately
    Select Case Err.Number
    Case Is = 0
        FileOrDirExists = True
    Case Else
        FileOrDirExists = False
    End Select
     
     'Resume error checking
    On Error GoTo 0
End Function

Sub macro1()
Dim t, cod As Integer
Dim xruta As String
Dim directory As String
Dim i As Integer
Dim dato1 As String
Dim range_dir As Range
Dim range_registro As Range
Dim wbk1, wbk2 As Workbook
xruta = ActiveWorkbook.Path

For t = 1 To 4
    For cod = 1 To 180

        directory = xruta & "\" & "2014T" & t & "AH" & cod & ".xls"
        registro1 = xruta & "\" & "registro" & ".xlsx"
        
        If FileOrDirExists(directory) = True Then
            Set wbk1 = Workbooks.Open(directory).Sheets(1)
                For i = 1 To 11
                    if Cells(i, 3).Value <> "" then
                        Call wbk1.Rows(CStr(i) & ":" & CStr(i + 100)).Copy
                        ThisWorkbook.Sheets(1).Range("a5").select 
                        While ActiveCell.Offset(0, 2) <> ""
                        ActiveCell.Offset(0, -2).Select
                        With Selection
                        .PasteSpecial (xlPasteValues)
                        Application.CutCopyMode = False
                        End With
                        Wend                    
                    end if
                Next
        
        End If
    Next
Next

End Sub

What is highlighted with red color is the one that doesn't work. It doesn't work with select or activate and I don't know why. I don't get to run the program because I can't activate the range and proceed to find if activecell.offset(0,2) is empty. Because if this cell is full, then this means there is the information of the last workbook copied (for example: the information of 2014T2AH54). I can't copy if this cell or range is fulled, because, as well as I said, I want to copy all the information going down without loosing any info.

I hope I could be explicit in my purpose and hope answers please,

just in case, I have an example attached of for example, also I have the workbook called "datos2" where the code is located and I have the workbook called "2014T2AH54" where which I have to extract this information!

thank you very much in advance,

Jos

[Tinbendr]

Sub macro1()
Dim t As Integer, cod As Integer
Dim xruta As String
Dim directory As String
Dim WBk1 As Workbook, WBk2 As Workbook
Dim LastRow As Long, NextRow As Long

xruta = ActiveWorkbook.Path

Set WBk2 = ThisWorkbook
With WBk2.Worksheets(1)
    NextRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
End With

For t = 1 To 4
    For cod = 1 To 180

        directory = xruta & "\" & "2014T" & t & "AH" & cod & ".xls"
        'directory = ThisWorkbook.Path & "\" & "2014T" & t & "AH" & cod & ".xls"
        
        If FileOrDirExists(directory) = True Then
            Set WBk1 = Workbooks.Open(directory, False, True)
            With WBk1.Worksheets(1)
                LastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
                .Range("C11:K" & LastRow).Copy _
                    Destination:=WBk2.Worksheets(1).Range("A" & NextRow)
                WBk1.Close False
            End With
        End If
    Next
Next

End Sub

[jcgonzales]

Thank you thank you thank you very much! you are an excellent user of VBA! nothing more to say just thank you and this code really works! excellent!