![](/img/trans.png)
[英]I am having 2 workbooks and I need to copy the columns from one workbook to another based on matching values
[英]I am trying to copy columns from one workbook to a master with fixed headings
好的,我想我已經閱讀了出現的每個選項,但還沒有從已經回答的選項中得到答案-如果已經回答了,請原諒我,我很特別。
我要做什么是以下幾點:
從具有固定(62)標題的主工作簿中,可以運行Macro / VBA,這將使我能夠打開文件(.csv),從該文件中獲取列並將其放在主表的相應標題下。
.csv文件肯定會具有與主文件匹配的列標題,但它可能沒有相同的順序。
您的幫助將不勝感激。
缺口
到目前為止,這是我有幫助的代碼...
Sub CopyCSV()
'' Find out how many rows are on the CSV sheet
LRCSV = Sheet1.UsedRange.Rows.Count
'' Find out how many columns are on the Data sheet
LCData = Sheet2.UsedRange.Columns.Count
For x = 2 To LRCSV
'' Find the last row and add one to get the first blank row
LRData = Sheet2.UsedRange.Rows.Count + 1
Sheet2.Activate
'' Finds the columns by the headers
If FirstN = "" Then
For y = 1 To LCData
If Cells(1, y).Value = "First Name" Then FirstN = y
If Cells(1, y).Value = "Surname" Then SurN = y
If Cells(1, y).Value = "Email" Then Email = y
If Cells(1, y).Value = "Telephone Number" Then TelN = y
Next y
End If
Sheet1.Activate
Sheet2.Cells(LRData, FirstN).Value = Sheet1.Cells(x, "A").Value
Sheet2.Cells(LRData, SurN).Value = Sheet1.Cells(x, "B").Value
Sheet2.Cells(LRData, Email).Value = Sheet1.Cells(x, "C").Value
Sheet2.Cells(LRData, TelN).Value = Sheet1.Cells(x, "D").Value
Next x
End Sub
我正在努力的按列查找部分...
尼克,我采取了一些不同的方法來解決您面臨的問題。 但是,我認為這將是一種更清潔的方法,並且更容易理解。
此代碼假定您已經打開了CSV。 另外,我為對象填寫了許多占位符。 根據您的需要進行更改。 我還評論了一下我認為可以幫助您更充分地理解代碼的地方。
Option Explicit
Sub CopyColumns()
'set the variables needed
Dim wkbMain As Workbook, wkbCopy As Workbook
Dim wksMain As Worksheet, wksCopy As Worksheet
Set wkbMain = Workbooks("Master.xlsm")
Set wkbCopy = Workbooks("email - pws a.csv")
Set wksMain = wkbMain.Sheets("Master")
Set wksCopy = wkbCopy.Sheets(1) 'csv files will only ever have 1 sheet
With wksMain
'capture the header row in the master sheet
Dim rngFind As Range, cel As Range
Set rngFind = Intersect(.UsedRange, .Rows(1)) 'assumes contigous header rows
'Set rngFind = .Range(.Range("A1"),.Range("A" & .Columns.Count).End(xlToRight) ' could use this as well if your data starts in cell A1
For Each cel In rngFind 'loop through each header in the row
Dim rngCopy As Range
With wksCopy
Set rngCopy = .Rows(1).Find(cel, after:=.Cells(1, .Columns.Count), lookat:=xlPart, LookIn:=xlValues) 'find the header name in the CSV sheet
'now copy the entire column (minus the header row)
Set rngCopy = .Range(rngCopy.Offset(1), .Cells(.Rows.Count, rngCopy.Column).End(xlUp))
rngCopy.Copy Destination:=wksMain.Cells(2, cel.Column) 'paste it to the matching header in the main sheet
End With
Next
End With 'this was missing
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.