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

尝试以下方法

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

Answer 2

我找到了一个解决方案，这是代码。谢谢大家的帮助。

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

用于将数据从“ .csv”文件复制到另一个“ .csv”文件的宏

2 个答案: