Question

我有一张有工作表的工作簿（＆＃34; 1001＆＃34;，＆＃34; 1002＆＃34;，＆＃34; 1003＆＃34; .....＆＃34; 1040＆＃34;）使用数据输入表（＆＃34;输入数据＆＃34;具有＆＃34;日期＆＃34;，＆＃34;详细信息＆＃34;＆＃34;金额＆＃34;）转移到两个不同的选定工作表。

我创建了一个MACRO，用于将数据从工作表（＆＃34;输入数据＆＃34;）传输到工作表（＆＃34; 1001＆＃34;）和工作表（＆＃34; 1002＆＃34;）但是接下来我需要将数据从工作表（＆＃34; 1003＆＃34;）传输到工作表（＆＃34; 1040）（来自工作表（＆＃34;输入数据＆＃34;），我必须在VBA中修改SheetName）代码。

我需要VBA代码才能在表单上输入这个必要的修改（＆＃34;输入数据＆＃34;），它会自动更改/修改我要转移的（VBA代码）中的工作表名称数据

Answer 1

在工作表中添加一个按钮（btnCopy）并添加以下代码：

Private Sub btnCopy_Click()
   TransferToSheet
End Sub

Private Sub TransferToSheet()
   Dim numSheetOrigin As Integer
Do
    numSheetOrigin = AskForSheetNumber("Enter a sheet number for origin:")
Loop Until WorksheetExists(numSheetOrigin)

Dim numSheetDestiny As Integer
Do
    numSheetDestiny = AskForSheetNumber("Enter a sheet number for destiny:")
Loop Until WorksheetExists(numSheetDestiny)

Application.ScreenUpdating = False


Dim wsOrigin As Worksheet
Dim wsDestiny As Worksheet
Dim r As Long
Dim m As Long
Dim cel As Range
Set wsOrigin = Worksheets(CStr(numSheetOrigin))
Set wsDestiny = Worksheets(CStr(numSheetDestiny))

Dim intRows As Integer
'Get the row number of the last cell containing data in the sheet:
intRows = Sheets(CStr(numSheetOrigin)).UsedRange.Rows.Count

'"Date", "Particulars" and "Amount" are columns a, b and c
wsOrigin.Activate
wsOrigin.Range("a1:c" & intRows).Select
Selection.Copy
wsDestiny.Select
ActiveSheet.Paste


''Another way
'wsOrigin.Range("a1:c" & intRows).Copy
'wsDestiny.Range("a1:c" & intRows).End(xlUp).Offset(1).PasteSpecial xlPasteValues
'wsDestiny.Close True

Dim wsName As String
wsDestiny.Name = Application.InputBox("Insert the name for the destiny sheet:")

Application.ScreenUpdating = True
End Sub


Public Function AskForSheetNumber(ByVal strText As String) As Integer
   'We only want to ask for numbers (type 1)
   AskForSheetNumber = Application.InputBox(prompt:=strText, Type:=1)
End Function


Public Function WorksheetExists(ByVal WorksheetName As Integer) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(CStr(WorksheetName)).Name <> "")
   On Error GoTo 0
End Function

使用不同的标准将数据从一张纸复印到不同的纸张

1 个答案: