Run-time error '1004': Method 'Rangę' of object '_Global failed

[Majlo7]

I wrote a subroutine to copy different columns from one worksheet and paste to another worksheet. Although the procedure works as expected, every time I execute the procedure I get the message "Runtime Error: 1004". Can anybody help identify the problem that is causing the runtime error in the code below? Thank you very much in advance.


the picture shows the problem and the last one shows what i want to get

when there is "Call listAllFiles" the procedure works badly and when it is not it works fine (good)
when there is "Call listAllFiles", the procedure works badly, and when it is not, everything is fine (good)

Option Explicit
Dim sheet As Worksheet


Sub listAllFiles()
Sheets("ŚT").Select
Arkusz1_ST.Range("A6:J6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ActiveCell.Offset(0, 0).Select

Dim Get_Path As String

With Application.FileDialog(msoFileDialogFolderPicker)

If .Show <> 0 Then
Get_Path = .SelectedItems(1)
End If
Worksheets("ŚT").Cells(2, 3).Value = Get_Path & "\"

End With

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(Sheets("ŚT").Range("Get_Path").Value)

Call GetFileDetails(objFolder)

End Sub



Function GetFileDetails(objFolder As Scripting.Folder)


Dim objFile As Scripting.File
Dim nextRow As Long
Dim objSubFolder As Scripting.Folder

nextRow = Cells(rows.Count, 1).End(xlUp).row + 1

On Error Resume Next

For Each objFile In objFolder.Files
Cells(nextRow, 1) = objFile.Name
Cells(nextRow, 2) = objFile.Path
Cells(nextRow, 3) = objFile.Type
Cells(nextRow, 4) = "=VLOOKUP(RC[-2],metadaneexport1!R3C2:R34932C7,2,0)"
Cells(nextRow, 4).NumberFormat = "m/d/yyyy h:mm"
Cells(nextRow, 5) = "=VLOOKUP(RC[-3],metadaneexport1!R3C2:R34932C7,3,0)"
Cells(nextRow, 5).NumberFormat = "m/d/yyyy h:mm"
Cells(nextRow, 6) = "=VLOOKUP(RC[-4],metadaneexport1!R3C2:R34932C7,4,0)"
Cells(nextRow, 6).NumberFormat = "m/d/yyyy h:mm"
Cells(nextRow, 7) = "=VLOOKUP(RC[-5],metadaneexport1!R3C2:R34932C7,5,0)"
Cells(nextRow, 7).NumberFormat = "m/d/yyyy h:mm"
Cells(nextRow, 8) = "=VLOOKUP(RC[-6],metadaneexport1!R3C2:R34932C7,6,0)"
Cells(nextRow, 8).NumberFormat = "m/d/yyyy h:mm"
ActiveSheet.Hyperlinks.Add Cells(nextRow, 9), objFile.Path, TextToDisplay:=objFile.Name
Cells(nextRow, 10) = "=HYPERLINK(SUBSTITUTE(RC[-8],""\""&RC[-9],""""))"
nextRow = nextRow + 1
Next

For Each objSubFolder In objFolder.SubFolders
Call GetFileDetails(objSubFolder)
Next
Sheets("ŚT").Select
Arkusz1_ST.Range("D6:H6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Function


Sub komendyCall()

Application.ScreenUpdating = False
USkorosztu:

For Each sheet In Application.Worksheets
If sheet.Name = "ŚT" Or sheet.Name = "metadaneexport1" Or sheet.Name = "" Then
If Application.Sheets.Count > 2 Then
Sheets("ŚT").Select
ActiveSheet.Move Before:=Sheets(1)
' Arkusz2.Visible = True
Sheets("metadaneexport1").Visible = True
Sheets("metadaneexport1").Select
ActiveSheet.Move Before:=Sheets(2)
Sheets("metadaneexport1").Visible = False

End If
Else
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(3).Activate
Sheets(3).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Next sheet

Dim row, row1, row2 As Long


Call listAllFiles



Proces2:
Sheets("ŚT").Select
'Dim row As String
Dim zakres As String
Range("A5").Select
row1 = Selection.End(xlDown).row
Range("D5").Select
row2 = Selection.End(xlDown).row
zakres = "" & "A5:A" & row1 & ",D5:H" & row2 & ""
Range(zakres).Select

End Sub

 

[Majlo7]

Dim Wier1 as Long, Wier2 As Long

This....

 Cells(Rows.Count, 1).End(xlUp).Row + 1

returns a value which causes an error because you have declared Wier2 as a string. I have no idea what your response "legal because I do not share it with anyone" means? Again, I do not have a good understanding of what broadly you are trying to achieve? Your code has been recorded (which always includes a lot of useless clutter), has no comments and uses a language foreign to me. So, I am unable to further assist you unless you are able to respond clearly to the many requests I have made for further information. Good luck. Dave

long what you suggested still error occurs

what questions do I have to answer

i just want to get this to the procedure

Range (Range (ActiveCell.Address, Selection.End (xlDown)). Address & "," & "D5: H" & Selection.End (xlDown) .Row) .Select

only selected columns for me

this procedure is clean as the above procedure does not exist

that is it

Dim Wier1 As Long, Wier2 As Long
Range ("I6"). Select
Wier2 = Cells (Rows.Count, 1) .End (xlUp) .Row + 1
Wier1 = ActiveCell.Row
Do While Wier1 <> Wier2


ActiveSheet.Hyperlinks.Add Cells (Line1, 9), Range ("B" & Line1) .Value, TextToDisplay: = Range ("A" & Line1) .Value
Line1 = Line1 + 1
Loop

and I want both procedures to be executed to the end of the vba code


long to co zasugerowałeś wciąż występuje błąd
jakie to pytania mam ci odpowiedzieć
chcę tylko uzyskać to aby procedura Range(Range(ActiveCell.Address, Selection.End(xlDown)).Address & ", " & "D5:H" & Selection.End(xlDown).Row).Select
zaznaczyła mi tylko wybrane kolumny
ta procedura jast wporzątku jak nie istnieje procedura powyżej

czyli to

Dim Wier1 As Long, Wier2 As Long
Range("I6").Select
Wier2 = Cells(Rows.Count, 1).End(xlUp).Row + 1
Wier1 = ActiveCell.Row
Do While Wier1 <> Wier2


ActiveSheet.Hyperlinks.Add Cells(Wier1, 9), Range("B" & Wier1).Value, TextToDisplay:=Range("A" & Wier1).Value
Wier1 = Wier1 + 1
Loop

a ja chcę aby obie procedury zostały wykonane do końca kodu vba

 

[Majlo7]

solved

 

[smozgur]

solved

Glad to hear that it is solved.

If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.