Ошибка 1004 при использовании Range Cell
Я сталкиваюсь с ошибками выполнения 1004 с этим куском кода. Это странно, потому что этот код работал в другом модуле, но когда я поместил его в лист пользовательской формы, он не работает.
Я обнаружил проблему, возникающую в этой строке при использовании точек останова
Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol), Cells(LastRow, FindCol))
Я исследовал и попробовал все, такие как
Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol)).Resize(LastRow)
Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol)).Resize(LastRow, LastCol)
With WorkBk.Worksheets(1)
.Range(.Cells(FindRow + 2, FindCol), .Cells(FindRow + 2, FindCol))
End With
И никто, казалось, не работал. Снова этот код работал раньше на другом модуле. Я не знаю, почему это не работает, когда я вставляю под командную кнопку sub для пользовательской формы.
Пожалуйста помоги
Полный код:
Dim FileName As String
Dim SummarySheet As Worksheet
Dim WorkBk As Workbook
Dim FolderPath As String
Dim LastRow As Long
Dim LastCol As Long
Dim NRow As Long
Dim NCol As Long
Dim SourceRange As Range
Dim DestRange As Range
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' Set Worksheet Name
ActiveSheet.Name = "BTS1 DL_HARQ"
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*BTS1_PHYMAC(DL_HARQ).csv*")
' Initialize column to 1
NCol = 1
' Loop until Dir returns an empty string.
Do While FileName <> ""
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
' Set the cell in row 1 to be the file name.
SummarySheet.Cells(1, NCol) = FileName
'Find the last row to be copied
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
'Find the last row to be copied
LastCol = ActiveSheet.Cells(13, Columns.Count).End(xlToLeft).Column
' Set the source range to be K14 to last row
' Modify this range for your workbooks.
' It can span multiple rows.
' Set SourceRange = WorkBk.Worksheets(1).Range("K14:K" & Lastrow)
Dim rFind As Range
Dim ColCount As Long
Dim FindRow As Long
Dim FindCol As Long
For ColCount = 1 To LastCol
With Range(Cells(1, ColCount), Cells(LastRow, ColCount))
Set rFind = .Find(What:="Tx Throughput [kbps]", LookIn:=xlValues, LookAt:=xlWhole)
If Not rFind Is Nothing Then
FindRow = rFind.Row
FindCol = rFind.Column
End If
End With
Next ColCount
Set SourceRange = WorkBk.Worksheets(1).Range(Cells(FindRow + 2, FindCol), Cells(LastRow, FindCol))
' Set the destination range to start at row 2 and
' be the same size as the source range.
Set DestRange = SummarySheet.Cells(NRow + 1, NCol)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)
' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
' Increase NCol to copy the next file on the next column
NCol = NCol + 1
Loop
End Sub
1 ответ
Я полагаю, что вам нужно ссылаться на свой рабочий лист при использовании Cells:
Set SourceRange = WorkBk.Worksheets(1).Range(WorkBk.Worksheets(1).Cells(FindRow + 2, FindCol), WorkBk.Worksheets(1).Cells(LastRow, FindCol))
Это очень поможет, если вы создадите переменную для этого рабочего листа, намного облегчит чтение и изменение.