Макрос для копирования данных из файла .csv в другой файл .csv

Question

Мне нужно разработать макрос, который позволяет мне копировать данные из файла с именем 'file.csv' в файл 'data.csv'.Первый файл может быть наполовину пуст, и поэтому сначала мне нужно искать данные.Самая важная часть в конце, когда я пытаюсь вставить его.Возвращает странную ошибку «Ошибка приложения или объекта», где есть ***.

    Sub dataComposer()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim Filename As String
    Dim begin As Integer
    Dim over As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim newSheet As Worksheet
    For y1 = 1 To 1 Step 1
    'Open the source file
    Set wkbTemp = Workbooks.Open(Filename:=ThisWorkbook.Path & "\file.csv")
    wkbTemp.Activate
    'Look for the part to copy
    For x1 = 1 To 200000 Step 1
        If IsEmpty(Cells(x1, 1)) = False Then
            begin = x1
            For x2 = x1 To 300000 Step 1
                If IsEmpty(Cells(x2, 1)) = True Then
                    over = x2
                    Exit For
                End If
            Next
            Exit For
        End If
    Next
    'Open the destination file
    Set wkbTemp1 = Workbooks.Open(Filename:=ThisWorkbook.Path & "\data.csv")

   'Copy the data from the source
    wkbTemp.Sheets(1).Cells.Copy
    Range(Cells(begin, 1), Cells(over - 1, 47)).Select
    Selection.Copy

    'Now, paste it into the destination
    Windows("data.csv").Activate
    Range(Cells(being, 1)).Select '***
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    'Save and close
    wkbTemp.Close
    wkbTemp1.Save
    wkbTemp1.Close

    Next

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True


    End Sub

Answer 1

Я нашел решение, и это код. Спасибо всем за помощь в любом случае.

Sub dataComposer()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim Filename As String
Dim begin As Long
Dim over As Long
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim newSheet As Worksheet
Dim g1 As Integer
Dim g2 As Integer
Dim n1 As String
Dim n2 As String
g1 = Worksheets("Sheet1").Range("B1").Value
g2 = Worksheets("Sheet1").Range("D1").Value
n1 = Worksheets("Sheet1").Range("B2").Value
n2 = Worksheets("Sheet1").Range("B3").Value
For y1 = g1 To g2 Step 1
    'Filename = ThisWorkbook.Path & "\data" & y1 & ".csv"
    'Workbooks.Open Filename
    Set wkbTemp = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & n1 & y1 & ".csv")
    wkbTemp.Activate
    For x1 = 1 To 200000 Step 1
        If IsEmpty(Cells(x1, 1)) = False Then
        'Cell A2 is not blank
            begin = x1
            For x2 = x1 To 300000 Step 1
                If IsEmpty(Cells(x2, 1)) = True Then
                    over = x2
                    Exit For
                End If
            Next
            Exit For
        End If
    Next



    'wkbTemp1.Activate

    Set wkbTemp_data = wkbTemp.Sheets(n1 & y1)


    wkbTemp_data.Cells.Copy
    Range(Cells(begin, 1), Cells(over - 1, 47)).Select
    Selection.Copy
    'Now, copy what you want from x:
    'wkbTemp.Sheets(1).Range(Cells(begin, 1), Cells(over - 1, 47)).Copy

    Set wkbTemp1 = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & n1 & ".csv")
    Set wkbTemp_data1 = wkbTemp1.Sheets(n1)

    'Now, paste to y worksheet:
    Windows(n1 & ".csv").Activate
    'wkbTemp1.Sheets(1).Activate
    Range(Cells(begin, 1), Cells(over - 1, 47)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


    'Activate Source Worksheet
    wkbTemp.Close
    wkbTemp1.Save
    wkbTemp1.Close
Next

For y1 = g1 To g2 Step 1
    'Filename = ThisWorkbook.Path & "\data" & y1 & ".csv"
    'Workbooks.Open Filename
    Set wkbTemp2 = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & n2 & y1 & ".csv")
    wkbTemp2.Activate
    For x1 = 1 To 200000 Step 1
        If IsEmpty(Cells(x1, 1)) = False Then
        'Cell A2 is not blank
            begin = x1
            For x2 = x1 To 300000 Step 1
                If IsEmpty(Cells(x2, 1)) = True Then
                    over = x2
                    Exit For
                End If
            Next
            Exit For
        End If
    Next



    'wkbTemp1.Activate

    Set wkbTemp_data2 = wkbTemp2.Sheets(n2 & y1)


    wkbTemp_data2.Cells.Copy
    Range(Cells(begin, 1), Cells(over - 1, 47)).Select
    Selection.Copy
    'Now, copy what you want from x:
    'wkbTemp.Sheets(1).Range(Cells(begin, 1), Cells(over - 1, 47)).Copy

    Set wkbTemp3 = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & n2 & ".csv")
    Set wkbTemp_data3 = wkbTemp3.Sheets(n2)

    'Now, paste to y worksheet:
    Windows(n2 & ".csv").Activate
    'wkbTemp1.Sheets(1).Activate
    Range(Cells(begin, 1), Cells(over - 1, 47)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    'Activate Source Worksheet
    wkbTemp2.Close
    wkbTemp3.Save
    wkbTemp3.Close

Next

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Answer 2

Попробуйте что-нибудь в этом духе

Set wkbTemp = ThisWorkbook.Path & "\file.csv"
Set wkbTemp1 = ThisWorkbook.Path & "\data.csv"

'assume data is on "sheet1"
Set wkbTemp_data = wkbTemp.Sheets("Sheet1")
Set wkbTemp_data1 = wkbTemp1.Sheets("Sheet1")

'Get last row in source wkb
LastRow = wkbTemp_data.Range("A" & Rows.Count).End(xlUp).Row    

'Get last col
Last_Col = Cells(1, Columns.Count).End(xlToLeft).Column

'Return Col name from number
LastColName = Split(Cells(, Last_Col).Address, "$")(1)        

'Get data to copy
wkbTemp_data1.Range(A1).Value wkbTemp_data.Range("A1:" & LastColName  & ":" & LastRow).Value