將工作簿工作表中的數據拉入另一個工作簿工作表的同一列

Question

將從客戶處以不同格式在 Excel 文件中接收數據。

通常該文件將有超過三張紙和每張紙中的多個列。 我需要特定的列。 我想將所需的列復制到分析文件的特定工作表。

我的代碼以交互方式顯示用戶表單，其中用戶提供工作表和列號，VBA 將從中獲取數據並捕獲用戶表單數據以供分析文件中的參考。

如果用戶選擇超過 5-6 列，則很難復制到同一工作表中的另一個文件，有時在同一列中必須動態調整並粘貼到現有數據下方。 根據我的理解，我不能只復制所選列中的數據。 它復制整列並在粘貼時復制，並且不允許在現有列中動態粘貼。

用戶表單：

Option Explicit
    
Private Sub CommandButton1_Click()
    
    Dim myColumn As Integer
    Dim eRow
    Dim mySheet As Integer
    Dim mySheet2 As Integer
    Dim myColumn2 As Integer
    Dim eRow2
    
    mySheet = Val(TextBox2.Text)
    Sheets(mySheet).Select
    myColumn = Val(TextBox1.Text)
    Columns(myColumn).Copy
    
    
    ThisWorkbook.Worksheets("Sheet2").Range("A1").PasteSpecial xlPasteValues
    
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1) = TextBox1.Text
    
    mySheet2 = Val(TextBox8.Text)
    Sheets(mySheet2).Select
    myColumn2 = Val(TextBox6.Text)
    Columns(myColumn2).Copy
    
    
    ThisWorkbook.Worksheets("Sheet2").Range("B1").PasteSpecial xlPasteValues
    
    eRow2 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow2, 1) = TextBox6.Text
    
    ThisWorkbook.Worksheets("Sheet2").Range("E4").Value = mySheet
    
    MsgBox ("Client data has been successfully added,vbOKOnly")
    
End Sub

模塊代碼：

Option Explicit
    
Public Sub Main()
    
    Dim myUserForm As UserForm1
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim xRg As Range
    Dim rng As Range
    
    
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range")
    
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
    
        Set myUserForm = New UserForm1
        myUserForm.Show
    
    End If
    
End Sub

Answer 1

您可以從特定范圍而不是整個列復制數據。 您必須更改您的 Columns(myColumn).Copy 以獲取類似 Range(myRange).Copy 的內容。

如果您從某個范圍獲取數據，請確保您粘貼數據的列不包含任何舊數據。 因為它只會覆蓋可能小於目標范圍的復制范圍內的數據。

如果要動態選擇目的地。 你可以使用這樣的東西： Range(myRange).end(xldown).offset(1,0).paste xlvalues

這個想法是“結束”將找到包含數據的最后一行。 “偏移”將給它下面的單元格，這就是你的目的地。

以下是這些屬性的文檔鏈接：

https://docs.microsoft.com/en-us/office/vba/api/excel.range.end

https://docs.microsoft.com/en-us/office/vba/api/excel.range.offset

Answer 2

也許您想升級到數據庫。 下面的代碼將通過 TransferSpreadsheet (VBA) 將單個文件夾中所有 EXCEL 文件中的所有工作表中的數據導入到單獨的表中...

    Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
    Dim intWorkbookCounter As Integer
    Dim lngCount As Long
    Dim objExcel As Object, objWorkbook As Object
    Dim colWorksheets As Collection
    Dim strPath As String, strFile As String
    Dim strPassword As String

    ' Establish an EXCEL application object
    On Error Resume Next
    Set objExcel = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
          Set objExcel = CreateObject("Excel.Application")
          blnEXCEL = True
    End If
    Err.Clear
    On Error GoTo 0

    ' Change this next line to True if the first row in EXCEL worksheet
    ' has field names
    blnHasFieldNames = False

    ' Replace C:\MyFolder\ with the actual path to the folder that holds the EXCEL files
    strPath = "C:\MyFolder\"

    ' Replace passwordtext with the real password;
    ' if there is no password, replace it with vbNullString constant
    ' (e.g., strPassword = vbNullString)
    strPassword = "passwordtext"

    blnReadOnly = True ' open EXCEL file in read-only mode

    strFile = Dir(strPath & "*.xls")

    intWorkbookCounter = 0

    Do While strFile <> ""

          intWorkbookCounter = intWorkbookCounter + 1

          Set colWorksheets = New Collection

          Set objWorkbook = objExcel.Workbooks.Open(strPath & strFile, , _
                blnReadOnly, , strPassword)

          For lngCount = 1 To objWorkbook.Worksheets.Count
                colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
          Next lngCount

          ' Close the EXCEL file without saving the file, and clean up the EXCEL objects
          objWorkbook.Close False
          Set objWorkbook = Nothing

          ' Import the data from each worksheet into a separate table
          For lngCount = colWorksheets.Count To 1 Step -1
                DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                      "tbl" & colWorksheets(lngCount) & intWorkbookCounter, _
                      strPath & strFile, blnHasFieldNames, _
                      colWorksheets(lngCount) & "$"
          Next lngCount

          ' Delete the collection
          Set colWorksheets = Nothing

          ' Uncomment out the next code step if you want to delete the
          ' EXCEL file after it's been imported
          ' Kill strPath & strFile

          strFile = Dir()

    Loop

    If blnEXCEL = True Then objExcel.Quit
    Set objExcel = Nothing

參考網址如下：

http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpAllWkshts