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

Majlo7

New Member
Joined
Sep 12, 2020
Messages
20
Office Version
  1. 2019
Platform
  1. Windows
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)

VBA Code:
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
 

Attachments

  • 1004.png
    1004.png
    2.4 KB · Views: 17
  • Przechwytywanie.JPG
    Przechwytywanie.JPG
    28.3 KB · Views: 27
  • Przechwytywanie2.JPG
    Przechwytywanie2.JPG
    103.1 KB · Views: 23
Last edited by a moderator:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Maybe just...
Code:
Range("A5:A" & row1 & ",D5:H" & row2).Select
As an aside, using selection is rarely needed and will slow down your code execution. HTH. Dave
 
Upvote 0
Maybe just...
Code:
Range("A5:A" & row1 & ",D5:H" & row2).Select
As an aside, using selection is rarely needed and will slow down your code execution. HTH. Dave


I've already tried it, and it didn't work
 
Upvote 0
Testing that section of code, both yours and mine work. Maybe remove the on error resume next and see what happens. Dave
 
Upvote 0
The part of code that you have shown above that errors has no errors. You have in your code "On Error Resume Next" which means that there may have been a previous error which is then skipped over... so remove that line of code and see where the error is. Dave
 
Upvote 0
Unfortunately, the forum rules won't allow that. You can post the wb directly to this site (maybe?) or provide a link to the wb at a dropbox site. See this site's info to see how to proceed. HTH. Dave
 
Upvote 0
Unfortunately, the forum rules won't allow that. You can post the wb directly to this site (maybe?) or provide a link to the wb at a dropbox site. See this site's info to see how to proceed. HTH. Dave


 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top