在工作簿之间难以复制

Question

我必须一次复制一个单元格，以便根据特定行中的值重新排列该行中的列。在一个工作簿中，此代码可以完美地从一张工作表复制到另一个工作表。现在，我已尝试将其扩展为在工作簿之间进行复制。我一辈子都无法让它发挥作用。如有任何帮助，我们将不胜感激。Ps(删除一些代码以简化

Dim bomWB As Workbook
Set bomWB = ThisWorkbook

strFullname = ("C:UsersAlexADesktop") & PartNo
Workbooks.Add.SaveAs Filename:=strFullname ', FileFormat:=xlcsv
Dim NewWB As Workbook
Set NewWB = ThisWorkbook
bomWB.Activate
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim R As Long
Dim L As Long
I = Worksheets("Main BOM").UsedRange.Rows.Count
Set xRg = Worksheets("Main BOM").Range("H2:H" & I)
On Error Resume Next
'Application.ScreenUpdating = False
For L = 1 To xRg.Count
If CStr(xRg(L).Value) = "0" Then GoTo Skip
R = R + 1

Workbooks(bomWB).Worksheets("Main BOM").Range("H" & L + 1).Copy _
Destination:=Workbooks(NewWB).Worksheets("Sheet1").Range("A" & R + 1)
Skip:
Next

Answer 1

Dim bomWB As Workbook
Set bomWB = ThisWorkbook

strFullname = ("C:UsersAlexADesktop") & PartNo
Workbooks.Add
Dim NewWB As Workbook
Set NewWB = ActiveWorkbook
bomWB.Activate
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim R As Long
Dim L As Long
I = Worksheets("Main BOM").UsedRange.Rows.Count
Set xRg = Worksheets("Main BOM").Range("H2:H" & I)
On Error Resume Next
'Application.ScreenUpdating = False
For L = 1 To xRg.Count
If CStr(xRg(L).Value) = "0" Then GoTo Skip
R = R + 1

bomWB.Worksheets("Main BOM").Range("H" & L + 1).Copy _
Destination:=NewWB.Worksheets("Sheet1").Range("A" & R + 1)
Skip:
Next
NewWB.SaveAs Filename:=strFullname, FileFormat:=xlCSV
NewWB.Close