Question

output should look like this

我编写了一个代码，该代码使用源文件复制数据并将其粘贴到主文件中。但是那里有3个不同的工作簿用于数据。现在由于有了新的供应商，他将数据提供在一个工作簿中，但在三个不同的工作表中。我所做的是连接单元格范围，每次我必须根据要放置在特定行或列中的数据更改单元格范围时。这是我需要花费的时间。我想完全自动化。

Call FillinData(sourceFile, destFile, "Bus", "B42:B53", "L", 10, 12)

我使用的上述格式。

原始数据为excel格式，excel文件有3张纸。我想将此数据复制到主文件中，该文件也有3张纸。因此，应该将sheet1的数据粘贴到主文件中的sheet1中。依此类推，剩下的3。我希望我的代码可以做的是：

1）选择原始数据。

2）比较主文件的列并将其粘贴。我希望代码在主文件中搜索正确的列名，然后将值粘贴到原始文件的正确列中。

我的代码在这里

Sub Values()

    Dim sourceFile As String
    Dim destFile As String

    Application.ScreenUpdating = False

    sourceFile = "C:\Users\Desktop\Source File Name"
    destFile = "C:\Users\Desktop\Dest File Name"

    Call FillinData(sourceFile, destFile, "Bus", "E57:E68", "D", 7, 12)

End Sub

Public Sub FillinData(ByVal Source As String, ByVal Dest As String, ByVal SheetName As String, ByVal sourceRange As String, ByVal destStartCellName As String, ByVal destStartCellNumber As Integer, ByVal count As String)

    Dim sourceData As Workbook
    Dim destData As Workbook

    Set sourceData = Workbooks.Open(Source)

    For Each C In ActiveSheet.Range(sourceRange)

        Set destData = Workbooks.Open(Dest)

        Worksheets(SheetName).Range(destStartCellName & destStartCellNumber) = C.Value

        destStartCellNumber = destStartCellNumber + 1

        destData.Save

        destData.Close

    Next C

    sourceData.Close

End Sub

Answer 1

类似于此示例的内容应该适合您。

Sub CopyDest3()

Dim shtImp As Worksheet
Dim shtSrc As Worksheet
Dim wbs As Workbook
Dim wbd As Workbook
Dim k As Integer
Set wbd = ThisWorkbook
Set wbs = Workbooks("Source_1.xlsx") 'presuming workbook is open
Set shtImp = wbd.Sheets("Dest")
k = 1
For k = 1 To 2
Set shtSrc = wbs.Sheets(k)

'From Source to Dest
Dim rngImpTitles As Range
Set rngImpTitles = shtImp.Rows(1)
Dim rngImpNames As Range
Set rngImpNames = shtImp.Columns(1)

Dim CopyColumn As Long
Dim CopyRow As Long
Dim foundRow As Long
Dim foundCol As Long

On Error Resume Next
'for each column in row 1 of import sheet
For CopyColumn = 2 To shtSrc.Cells(1, shtSrc.Columns.count).End(xlToLeft).Column
    foundCol = rngImpTitles.Find(shtSrc.Cells(1, CopyColumn).Value2).Column
    If Err.Number <> 0 Then
        MsgBox "Not such a col title in importsheet for " & vbNewLine & _
                        shtSrc.Cells(1, CopyColumn)
        Err.Clear
        GoTo skip_title
    End If


    For CopyRow = 2 To shtSrc.Cells(shtSrc.Rows.count, 1).End(xlUp).Row
        foundRow = rngImpNames.Find(shtSrc.Cells(CopyRow, 1)).Row
        If Err.Number <> 0 Then
            MsgBox "Not such a row name in importsheet for " & vbNewLine & _
                        shtSrc.Cells(CopyRow, 1)
            Err.Clear
            GoTo skip_row
        End If

            If Len(shtSrc.Cells(CopyRow, CopyColumn)) <> 0 Then
                    shtSrc.Cells(CopyRow, CopyColumn).Copy shtImp.Cells(foundRow, foundCol)
            End If

skip_row:
    Next CopyRow
skip_title:
Next CopyColumn
Next k
End Sub

合适的列匹配

1 个答案: