Question

我有两个excel文件，我只需要将原始数据表中的必要行复制到我的新工作簿中。

我到目前为止的代码是：

Sub Pop_Sheet()

  Dim WB As Workbook                                  ' Declare variables and types
  Dim WS As Worksheet
  Dim NumRows As Integer
  Dim BadCols As Range
  Dim BadRow As Range


  Set WB = Get_File()                                 ' Get file from user
  Set WS = WB.Sheets(1)                               ' Select first sheet in workbook

                                                      ' Delete unneeded rows/columns
  Set BadCols = WS.Range("A:A,B:B,D:D,G:G,H:H,I:I,J:J,K:K,L:L,M:M,P:P,Q:Q,R:R,S:S,V:V,W:W,X:X,AA:AA,AC:AC,AE:AE,AF:AF,AG:AG,AH:AH,AI:AI,AL:AL,AO:AO,AP:AP,AV:AV,AW:AW,AX:AX,AY:AY,AZ:AZ,BA:BA,BB:BB,BC:BC,BD:BD,BE:BE,BF:BF,BG:BG")
  Set BadRow = WS.Rows("1:1")

  BadCols.Delete
  BadRow.Delete

  WS.Columns("N:N").Select                            ' Insert empty column at N
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

  NumRows = WS.Range("A1048576").End(xlUp).Row        ' Count number of rows used in raw data

  Rows("5:" + (5 + NumRows)).Select                   ' Insert X rows above...It should at least... Errors out before here
  ActiveCell.EntireRow.Insert

  WS.Range("A1:U" + NumRows).Select.Copy              ' Copy and paste ???
  Rows("4:" + (4 + NumRows)).Select.Paste

  Close_File (WB)                                     ' Clean up, free memory
  Set WB = Nothing
  Set WS = Nothing
  Set BadCols = Nothing
  Set BadRow = Nothing

End Sub

Private Function Get_File() As Workbook

  Dim FPath As Variant                                ' Declare variable for filepath
                                                      ' Get path from file picker
  FPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select File To Import")

  If Not FPath = False Then                           ' If a file was chosen
    Set Get_File = Workbooks.Open(FPath)              ' Open file
  Else
    Set Get_File = Nothing                            ' Otherwise do nothing
  End If

  Set FPath = Nothing                                 ' Free Memory

End Function

Private Sub Close_File(ByRef WB As Workbook, Optional Save As Boolean = False)

  WB.Close (Save)                                     ' Close raw data workbook

End Sub

但是当我运行它时出现“类型不匹配”错误。我认为它与复制和粘贴到不同大小的单元格有关，这就是为什么我试图插入所需的数字，选择它们并粘贴到它们中。

我们非常感谢任何帮助或指导。谢谢！

Answer 1

简短的回答是这一行不正确：

Rows("5:" + (5 + NumRows)).Select

相反，您需要使用“连接”运算符，即“＆amp;”：

Rows("5:" & (5 + NumRows)).Select

你需要修复你做同样事情的其他行。 “＆安培;”结合了两个字符串。

答案很长，你的代码可以被清理很多，以使它更快更容易阅读。我的主要建议是不要“选择”事物然后“做”动作 - 只需将动作附加到范围本身（用**标记的编辑）：

Sub Pop_Sheet()

  Dim WB As Workbook                                  ' Declare variables and types
  Dim WS As Worksheet
  Dim NumRows As Integer
  Dim BadCols As Range
  Dim BadRow As Range


  Set WB = Get_File()                                 ' Get file from user
  Set WS = WB.Sheets(1)                               ' Select first sheet in workbook

                                                      ' Delete unneeded rows/columns
  Set BadCols = WS.Range("A:B,D:D,G:M,P:S,V:X,AA:AA,AC:AC,AE:AI,AL:AL,AO:AP,AV:BG")   'Can select multiple adjacent columns by using start and end columns
  Set BadRow = WS.Rows(1)      ' ** This function can just take a number rather than the range string

  BadCols.Delete
  BadRow.Delete

  WS.Columns("N:N").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove                           ' ** Combine two steps

  NumRows = WS.UsedRange.Rows.Count        ' ** Count number of rows used in raw data

  WS.Range(WS.Rows(5),WS.Rows(5 + NumRows)).Insert                   ' ** Should work better

  WS.Range("A1",WS.Cells(NumRows,21)).Copy destination:=Range(Rows(4),Rows(4+NumRows))              ' Copy and paste ???

  Close_File (WB)                                     ' Clean up, free memory
  Set WB = Nothing
  Set WS = Nothing
  Set BadCols = Nothing
  Set BadRow = Nothing

End Sub

Answer 2

替换它：

Rows("5:" + (5 + NumRows)).Select 
ActiveCell.EntireRow.Insert
WS.Range("A1:U" + NumRows).Select.Copy
Rows("4:" + (4 + NumRows)).Select.Paste

有了这个：

Rows("5:" & (5 + NumRows)).EntireRow.Insert
WS.Range("A1:U" + NumRows).Copy
WS.Paste Destination:=Range("D1")

让我知道它是如何运作的。

使用VBA从第二个工作簿复制和粘贴时键入不匹配

2 个答案: