我一直在尝试从另一个文件（从几张纸）复制几列。
我创建了一种矩阵，用户可以在其中配置要复制的名称和列位置。我意识到当我的代码要复制的列中有空白时，它会跳过空白单元格旁边的信息，然后移至下一页。
我想到的另一种选择是用模块作为函数填充所有空白，并将其调用到我的主程序中，但是我不知道怎么做：
'GLOBAL VARIABLES
'
'Variable used to pick a file in the beginning ("Activo Fijo" File)
Dim file_in As String
'Variable to name the Workbook where are generated the macro file
Dim Entrance As Workbook
'Variable to calculate the accumulated range of the "Activo Fijo" (columns)
Dim x, a As Long
'Variables to measure the rows and columns on the "Configuration" sheet (located on the Macro Workbook)
Dim y, w As Integer
'Variable to measure the copy range from "Activo Fijo"
Dim seg1 As String
'Variable to copy info
Dim copyinfo As String
'Variable to locate the "Activo Fijo" file sheets on the matrix
Dim pestana As String
'Variable to measure the matrix range
Dim seg2 As RANGE
'Variable to change the matrix range
Dim rangesize As String
'Variable to create the new Workbook where is pasted the info
Dim wc As Workbook
'CLEAR THE ALREADY CONSOLIDATED DATA
'
'Subroutine to erased the old data and generate the new ones
Sub clean()
Me.Sheets(2).Cells.ClearContents
End Sub
'CONSOLIDATING ALL SOURCES AND NECESSARY SHEETS FROM "ACTIVO FIJO" FILE
'
'Subroutine to take all necessary information from the input file to create PANDA file
Sub ActivoFijo()
'sentences to avoid unnecessary Pop-Ups
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Instruction to pick a file ("Activo Fijo" File)
file_in = Module1.pick_file("Selecionar Activo Fijo")
If (file_in = "") Then
'Exit if the file is not found
Exit Sub
End If
'Open if the file is found
Set Entrance = Workbooks.Open(file_in)
clean
'Giving value 1 to skip headers
a = 1
'Measuring until the last row on the "Configuration" sheet
y = Me.Sheets(3).Cells(1, 1).End(xlDown).Row
'Measuring until the last column on the "Configuration" sheet
w = Me.Sheets(3).Cells(1, 1).End(xlToRight).Column
'LOOP TO GENERATE CONSOLIDATED INFO
'
'READING THE DATA ON THE MATRIX LOCATED ON THE "CONFIGURATION" SHEET
'
Do While y <> 1
'Pop-Up that shows up if exist and column name error
pestana = Me.Sheets(3).Cells(y, 1).Value
On Error Resume Next
If IsError(Entrance.Sheets(pestana).Select) Then
Msgbox ("El nombre de alguna pestaña esta mal escrito. Reviselo y vuelva a ejecutar")
Else
End If
Entrance.Sheets(pestana).Select
rangesize = Me.Sheets(3).Cells(y, 2).Value
Set seg2 = RANGE(rangesize, RANGE(rangesize).End(xlDown))
x = seg2.Count
For Z = 2 To w
'READING THE DATA ON THE "ACTIVO FIJO" FILE AFTER HAVE BEEN SEARCHED ON THE MATRIX
'
If a = 1 Then
Me.Sheets(2).Cells(1, Z - 1).Value = Me.Sheets(3).Cells(1, Z).Value
copyinfo = Me.Sheets(3).Cells(y, Z)
If Z = w Then
'Loop to "TRAMOS FO" Sheet to add to its columns the "x"item (item used on the process)
If copyinfo <> "" Then
For tfo = 1 To x
Me.Sheets(2).Cells(a + tfo, Z - 1).Value = copyinfo
Next tfo
End If
Else
'If the column is not needed or is not mapping on the matrix, go to next column
If copyinfo = "" Then
GoTo moveforeward
Else
If IsNumeric(Mid(copyinfo, 2, 1)) Then
'Copying info if occurs the first case
seg1 = copyinfo & ":" & Left(copyinfo, 1) & seg2.item(x).Row
RANGE(seg1).copy
'Pasting info if occurs the first case
Me.Sheets(2).Cells(a + 1, Z - 1).PasteSpecial Paste:=xlPasteValues
Else
'Copying info if occurs the second case
seg1 = copyinfo & ":" & Left(copyinfo, 2) & seg2.item(x).Row
RANGE(seg1).copy
'Pasting info if occurs the second case
Me.Sheets(2).Cells(a + 1, Z - 1).PasteSpecial Paste:=xlPasteValues
End If
End If
End If
Else
copyinfo = Me.Sheets(3).Cells(y, Z)
If Z = w Then
'Loop to "TRAMOS FO" Sheet to add to its columns the "x"item (item used on the process)
If copyinfo <> "" Then
For tfo = 1 To x
Me.Sheets(2).Cells(a + 1 + tfo, Z - 1).Value = copyinfo
Next tfo
End If
Else
'If the column is not needed or is not mapping on the matrix, go to next column
If copyinfo = "" Then
GoTo moveforeward
Else
'If the column is out of range, change it to the mid item and read from there to do not copy unnecessary info
If IsNumeric(Mid(copyinfo, 2, 1)) Then
seg1 = copyinfo & ":" & Left(copyinfo, 1) & seg2.item(x).Row
RANGE(seg1).copy
Me.Sheets(2).Cells(a + 1, Z - 1).PasteSpecial Paste:=xlPasteValues
Else
'If the column is not out of range, read it normal
seg1 = copyinfo & ":" & Left(copyinfo, 2) & seg2.item(x).Row
RANGE(seg1).copy
Me.Sheets(2).Cells(a + 1, Z - 1).PasteSpecial Paste:=xlPasteValues
End If
End If
End If
End If
moveforeward:
Next Z
'formulas to keep increasing and decreasing ranges
y = y - 1
a = a + x
Loop
SaveFile
Entrance.Close
End Sub
'SAVING NEW "ACTIVO FIJO" FILE ALREADY CONSOLIDATED
'
'Subroutine to copy consolidated "Activo fijo" File sheet on a new Workbook
Sub SaveFile()
'Variable to create a new workbook
Set wc = Workbooks.Add
'Using "Me" Variable to copy sheet 2 from the macro file
'Using destination property to paste sheet 2 from the macro file on the already created new Workbook ("wc" variable)
Me.Sheets(2).UsedRange.copy Destination:=wc.Sheets(1).RANGE("A1")
'Using TempFile properties to saving the new Workbook as a new file with XSLX extention, and name it as "AF" (Do Not Change name). It will be used on the nex processes
TempFilePath = Application.DefaultFilePath & "\"
TempFileName = "AF" & "_" & Format(Now, "mm-yy")
With wc
.SaveAs TempFilePath & TempFileName
.Close SaveChanges:=False
'Pop-Up that shows up the path and the save file direction
End With
Msgbox "A generado un nuevo archivo en " & TempFilePath
'Ending routine
End Sub