Подзаголовок вне допустимого диапазона Копирование VBA в csv

Question

При написании фрагмента кода я столкнулся с сообщением «Subscript out of range».

Структура папки выглядит следующим образом: D: \ Documents основной каталог Внутри него есть: XLS книги с кодом файл 1.csv, к которому мне нужно скопировать данные папку WIP который содержит CSV файлы с данными

в настоящее время код выглядит следующим образом

Sub MergeData() 
' 
' Ìàêðîñ1 Ìàêðîñ 

' Provide path to workbooks, 
' there is a folder with about 100 csv books from which I should collect data into one 

    Dim Filename, Pathname As String 
    Dim wb As Workbook 
    Pathname = ActiveWorkbook.Path & "\WiP\" 
    Filename = Dir(Pathname & "*.csv") 

' Open a workbook in which the data should be pasted 

    Workbooks.Open ("D:\Documents\1.csv") 
     ActiveSheet.Cells(1, 1).Value = "date" 
     ActiveSheet.Cells(1, 2).Value = "hour" 
     ActiveSheet.Cells(1, 3).Value = "num" 
     ActiveSheet.Cells(1, 4).Value = "p" 

' Call the code 

    Do While Filename <> "" 
     Set wb = Workbooks.Open(Pathname & Filename) 
     IntegrateDays wb 
     wb.Close savechanges:=False 
     Filename = Dir() 
    Loop 

' Close the workbook with data 

    Workbooks("D:\Documents\1.csv").Close savechanges:=True 


End Sub 


Sub IntegrateDays(wb As Workbook) 

Dim ws As Worksheet 
    With wb 

' Open workbooks, copy a range 

      Sheets(1).Activate 
      Dim rng As Range 
        Set rng = Range(Cells(1, 1), Cells(1, 1).End(xlDown)) 
        rng.Copy 

' Paste the range into 1.csv 

      Workbooks("D:\Documents\1.csv").Worksheets(1).Range("B" & Worksheets(1).UsedRange.Rows.Count + 1).Activate 
      rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
      :=False, Transpose:=False 
      Application.CutCopyMode = False 
      Set NextRow = Nothing 

    End With 

End Sub 

код работает до тех пор, пока вставить скопированный диапазон ГСЧ в 1.csv и останавливается с ошибкой. Первое предположение, что это может быть ошибка, связанная с range.activate. Я попытался протестировать его, выполнив операцию без цикла и выбрав только одну ячейку, а затем просто открыв 1.csv, прежде чем выбирать любые диапазоны. Ошибка остается. Второе подозрение в том, что есть проблема с открытием 1.csv. Если посмотреть, что поиски, такие как «индекс вне диапазона открытия csv», я не нашел внятно обсуждаемых вопросов, которые могли бы помочь в этом вопросе.

Не могли бы вы любезно сообщить мне, что послужило причиной ошибки и как переписать код?

спасибо, что заранее.

Evgeniya.

Answer 1

Вы не должны использовать rng.PasteSpecial. Родительом Range.PasteSpecial method должен быть пункт назначения; а не источник.

Поскольку вы заинтересованы в получении значений, откажитесь от PasteSpecial в пользу прямой передачи стоимости.

Dim rng As Range 
with Sheets(1) 
    Set rng = .Range(Cells(1, 1), Cells(1, 1).End(xlDown)) 
end with 

with Workbooks("D:\Documents\1.csv").Worksheets(1) 
    .cells(rows.count, "B").end(xlup).offset(1,0).resize(rng.rows.count, rng.columns.count) = rng.Value 
end with 

Answer 2

Вы пытаетесь скопировать книгу из других книг? Попробуйте настроить этот

Application.ScreenUpdating = False 
Columns("A:C").Sort Key1:=Range("C2"), _ 
Order1:=xlDescending, Header:=xlYes 

Application.ScreenUpdating = True 

Dim WBookCopy As Workbook 
Dim WBookPst As Workbook 
Dim Filepath As String 
Dim SheetName As String 
Dim sheetCopy As Worksheet 

Set WBookPst = Application.ActiveWorkbook 
Call DeleteCache 
'B2 is the location directory of latest Excel file 
Filepath = Range("B2").Value 
Set WBookCopy = Workbooks.Open(Filepath) 

Set sheetPst = WBookPst.Worksheets(2) 
Set sheetCopy = WBookCopy.Worksheets(1) 

sheetCopy.UsedRange.Copy sheetPst.Range("A:AG") 
sheetCopy.UsedRange.Value = sheetCopy.UsedRange.Value 

WBookCopy.Close (False)