VBA怎么把工作簿A中的第N列，复制到工作簿B中的第N列。

Question

问题遇到的现象和发生背景

用代码块功能插入代码，请勿粘贴截图

我的解答思路和尝试过的方法

我想要达到的结果 VBA怎么把工作簿A中的第N列，复制到工作簿B中的第N列。

Answer 1

好像需求描述还有些二义，例如是整列覆盖？还是在目标表对应列最后一行追加？
是两个独立表格文件两个“工作簿”？
还是可以理解为同一个文件（工作簿）中的两个不同“工作表”？
有没有需指定“工作表”中Sheet？

假设两个独立EXCEL表格文件（工作簿）的工作表均为Sheet1
可以参考如下代码（在MS Office Excel测试通过）按实际需求进一步调整

Sub copy_AToB()
   Dim Wbook1 As Workbook, Wbook2 As Workbook
   Dim path_A, path_B
   Dim ABookName, BBookName   '假设两个独立表格文件
   Dim aCol As Integer, bCol As Integer
   
   Application.ScreenUpdating = False  '暂停刷新
 
   path_A = "D:\"
   ABookName = "checkA.xlsx"   'A表格文件名称
   
   path_B = "E:\"
   BBookName = "checkB.xlsx"   'B表格文件名称
   aCol = 3   'A表格的源列号 按需求灵活调整
   bCol = 6   'B表格的目标列号
   
   If ABookName = BBookName Then
      MsgBox "两个文件名称不能相同", vbInformation, "提示"
      Exit Sub  ‘若不符合逻辑则退出
   End If
   
   ABookName = path_A & ABookName  '加路径组合
BBookName = path_B & BBookName
   
   If Dir(ABookName, 16) = vbNullString Then  '检查文件是否存在
      MsgBox "未找到 " & ABookName, vbInformation, "提示"
      Exit Sub
   End If
   
   If Dir(BBookName, 16) = vbNullString Then
      MsgBox "未找到 " & BBookName, vbInformation, "提示"
      Exit Sub
   End If
   '文件存在的条件为 Not Dir(ABookName, 16) = vbNullString
   
   
      Set Wbook1 = Workbooks.Open(ABookName)  '打开A文件
      Set Wbook2 = Workbooks.Open(BBookName)  '打开B文件
      Wbook1.Sheets(1).Activate
      ActiveSheet.Columns(aCol).Copy  '复制列
      
      Wbook2.Sheets(1).Activate
      ActiveSheet.Columns(bCol).PasteSpecial  '拷贝至目标列
      
      '清空剪贴板，避免关闭文件命令时弹出提示类似“在剪贴板上有大量信息。是否保留其内容，以便此后粘贴到其他程序中？”
      Application.CutCopyMode = False '清空
      
      Wbook1.Close  '关闭A文件
      
      Wbook2.Save   '保存B文件
      'Wbook2.SaveAs Filename:="E:\checkB_New.xlsx"  '此句测试另存为新文件
      Wbook2.Close  '关闭B文件
      
      MsgBox "从" & ABookName & "拷贝至" & BBookName & "完成", vbInformation, "提示"
 
   
   Application.ScreenUpdating = True
 
End Sub

Answer 2

1.在目标表对应列最后一行追加
2.是两个独立表格文件两个“工作簿”
3.有需指定“工作表”中Sheet1
4.将A工作簿中的sheet1新增数据n列，添加到B工作簿的i列。其中n和i是变量。
5.简单来说就是把A工作簿下的sheet1表格新增的一列数据追加到B工作簿下的sheet1表格。
6在目标表格追加
7.并且AB工作簿下的sheet表列数不同，需要读取两个表的已有列数，从而进行追加

Answer 3

更新列末尾追加方式

Sub copy_AToB()
   '假设两个独立表格文件，源表复制列内容后，在目标列后面粘贴
   Dim Wbook1 As Workbook, Wbook2 As Workbook
   Dim path_A, path_B        '测试路径
   Dim ABookName, BBookName  '测试文件名称
   Dim aCol As Integer, bCol As Integer  '列号
   Dim i As Integer  '行数
   Dim j As Integer  '列数
   Dim k As Integer  '搜索某列最后一个非空单元格行号
   
   
   Application.ScreenUpdating = False  '暂停刷新
   'Application.DisplayAlerts = False '使不弹出询问 是否替换目标单元格内容
   
   path_A = "D:\"
   ABookName = "checkA.xlsx"   'A表格文件名称
   
   path_B = "E:\"
   BBookName = "checkB.xlsx"   'B表格文件名称
   aCol = 3   'A表格的源列号 按需求灵活调整
   bCol = 6   'B表格的目标列号
   
   If ABookName = BBookName Then
      MsgBox "两个文件名称不能相同", vbInformation, "提示"
      Exit Sub
   End If
   
   ABookName = path_A & ABookName  '加路径组合
BBookName = path_B & BBookName
   
   If Dir(ABookName, 16) = vbNullString Then  '检查文件是否存在
      MsgBox "未找到 " & ABookName, vbInformation, "提示"
      Exit Sub
   End If
   
   If Dir(BBookName, 16) = vbNullString Then
      MsgBox "未找到 " & BBookName, vbInformation, "提示"
      Exit Sub
   End If
   '文件存在的条件为 Not Dir(ABookName, 16) = vbNullString
   
   
   Set Wbook1 = Workbooks.Open(ABookName)  '打开A文件
   Wbook1.Sheets(1).Activate
 
   '取行数
   i = Wbook1.Sheets(1).UsedRange.Cells(Sheets(1).UsedRange.Rows.Count, 1).Row
   
   '取列数
   j = Wbook1.Sheets(1).UsedRange.Cells(1, Sheets(1).UsedRange.Columns.Count).Column
   
   If i = 1 And IsEmpty(Cells(1, aCol).Value) Then
      MsgBox BBookName & " 第1行第" & aCol & "列没有数据", vbExclamation, "提示"
         
      Wbook1.Close   '关闭A文件
      Exit Sub
   End If
 
 
   'ActiveSheet.Columns(aCol).Copy  '整列复制，这方式粘贴至目标表可整列覆盖，较少用
 
   k = ActiveSheet.Cells(Rows.Count, aCol).End(xlUp).Row  '源表对应列最后一个非空单格行号
   'Cells(Rows.Count, 1) 表示找第1列最后一个非空单格
   'End(xlUp) 表示向上搜索，可写为End(3)
   
   '复制源表对应列第1行至最后行的内容
   '若第一行为列名称不复制，则调整行号为2开始，即下方“Cells(1, aCol)”改为“Cells(2, aCol)”
   With Worksheets(1)
      .Range(.Cells(1, aCol), .Cells(k, aCol)).Copy
   End With
 
   Set Wbook2 = Workbooks.Open(BBookName)  '打开B文件
   Wbook2.Sheets(1).Activate
   'ActiveSheet.Columns(bCol).PasteSpecial  '拷贝至目标列 整列覆盖方式较少用
 
   k = ActiveSheet.Cells(Rows.Count, bCol).End(xlUp).Row  '目标工作表对应列最后一个非空单格行号
   If (k = 1 And Not IsEmpty(Cells(1, bCol).Value)) Or k > 1 Then
      '若返回非空单元格行号为“1”，且对应列第1个单元格不为空
      '或者非空单元格行号大于“1”
      k = k + 1  '调整将要粘贴的起始空行号+1
   End If
 
   ActiveSheet.Cells(k, bCol).PasteSpecial  '对应目标列非空单元格的下一行单元格位置粘贴
 
   '清空剪贴板，避免关闭文件命令时弹出提示类似“在剪贴板上有大量信息。是否保留其内容，以便此后粘贴到其他程序中？”
   Application.CutCopyMode = False '清空
      
      Wbook1.Close  '关闭A文件
      
      Wbook2.Save   '保存B文件
      'Wbook2.SaveAs Filename:="E:\checkB_New.xlsx"  '此句测试另存为新文件
      Wbook2.Close  '关闭B文件
      
   MsgBox "将 " & ABookName & " （源表共" & i & "行" & j & "列）的第" & aCol & "列拷贝至 " & BBookName & " 第" & bCol & "列完成", vbInformation, "提示"
 
   Application.ScreenUpdating = True
 
End Sub