麻烦写一条简单的跨工作薄复制的vba代码

发布网友 发布时间：2022-04-24 03:38

我来回答

共4个回答

热心网友 时间：2023-10-25 10:42

Sub 宏1()
'
' 宏1 宏
    Dim pos  As String
 
    Sheets("Sheet1").Select         '激活工作表sheet1
    Range("A1:D11").Select          '选择要剪切的区域
    Application.CutCopyMode = False
    Selection.Cut                   '剪切选择的区域
    
    Application.DisplayAlerts = False   '禁止显示消息框
    Application.ScreenUpdating = False  '禁止屏幕闪烁
     
    Set wk = Workbooks.Open(ThisWorkbook.Path & "\工作簿2.xlsx")    '打开另一张表
    With ActiveWorkbook
        Sheets("Sheet1").Select         '激活工作表sheet1
         
        For i = 1 To 60000              '定位到要粘贴的位置
            pos = "A" & i
            If Range(pos) = "" Then     '如果单元格内容为空，则粘贴
                Range(pos).Select
                ActiveSheet.Paste
                GoTo OVER                '粘贴后就跳出for循环
            End If
        Next i
    End With
OVER:
    wk.Close savechanges:=True
    Set wk = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub

热心网友 时间：2023-10-25 10:42

首先打开别的工作部-复制到打开工作簿-保存关闭

热心网友 时间：2023-10-25 10:42

Sub 宏1()
'
' 宏1 宏
    Dim pos  As String
 
    Sheets("Sheet1").Select         '激活工作表sheet1
    Range("A1:D11").Select          '选择要剪切的区域
    Application.CutCopyMode = False
    Selection.Cut                   '剪切选择的区域
    
    Application.DisplayAlerts = False   '禁止显示消息框
    Application.ScreenUpdating = False  '禁止屏幕闪烁
     
    Set wk = Workbooks.Open(ThisWorkbook.Path & "\工作簿2.xlsx")    '打开另一张表
    With ActiveWorkbook
        Sheets("Sheet1").Select         '激活工作表sheet1
         
        For i = 1 To 60000              '定位到要粘贴的位置
            pos = "A" & i
            If Range(pos) = "" Then     '如果单元格内容为空，则粘贴
                Range(pos).Select
                ActiveSheet.Paste
                GoTo OVER                '粘贴后就跳出for循环
            End If
        Next i
    End With
OVER:
    wk.Close savechanges:=True
    Set wk = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub

热心网友 时间：2023-10-25 10:42

首先打开别的工作部-复制到打开工作簿-保存关闭

热心网友 时间：2023-10-25 10:43

录制一下就能得到代码

热心网友 时间：2023-10-25 10:44

这个套路容易看明白吧：
WorkBooks("1.xlsx").Sheets("sheet1").Range("a1:d5").Copy WorkBooks("2.xlsx").Sheets("sheet2").Range("a1:d5")
上面是复制单元格区域，如果需要复制工作表：
WorkBooks("1.xlsx").Sheets("sheet1").Copy After:=WorkBooks("2.xlsx").Sheets("sheet2")

热心网友 时间：2023-10-25 10:43

录制一下就能得到代码

热心网友 时间：2023-10-25 10:42

Sub 宏1()
'
' 宏1 宏
    Dim pos  As String
 
    Sheets("Sheet1").Select         '激活工作表sheet1
    Range("A1:D11").Select          '选择要剪切的区域
    Application.CutCopyMode = False
    Selection.Cut                   '剪切选择的区域
    
    Application.DisplayAlerts = False   '禁止显示消息框
    Application.ScreenUpdating = False  '禁止屏幕闪烁
     
    Set wk = Workbooks.Open(ThisWorkbook.Path & "\工作簿2.xlsx")    '打开另一张表
    With ActiveWorkbook
        Sheets("Sheet1").Select         '激活工作表sheet1
         
        For i = 1 To 60000              '定位到要粘贴的位置
            pos = "A" & i
            If Range(pos) = "" Then     '如果单元格内容为空，则粘贴
                Range(pos).Select
                ActiveSheet.Paste
                GoTo OVER                '粘贴后就跳出for循环
            End If
        Next i
    End With
OVER:
    wk.Close savechanges:=True
    Set wk = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub

热心网友 时间：2023-10-25 10:43

首先打开别的工作部-复制到打开工作簿-保存关闭

热心网友 时间：2023-10-25 10:43

录制一下就能得到代码

热心网友 时间：2023-10-25 10:42

Sub 宏1()
'
' 宏1 宏
    Dim pos  As String
 
    Sheets("Sheet1").Select         '激活工作表sheet1
    Range("A1:D11").Select          '选择要剪切的区域
    Application.CutCopyMode = False
    Selection.Cut                   '剪切选择的区域
    
    Application.DisplayAlerts = False   '禁止显示消息框
    Application.ScreenUpdating = False  '禁止屏幕闪烁
     
    Set wk = Workbooks.Open(ThisWorkbook.Path & "\工作簿2.xlsx")    '打开另一张表
    With ActiveWorkbook
        Sheets("Sheet1").Select         '激活工作表sheet1
         
        For i = 1 To 60000              '定位到要粘贴的位置
            pos = "A" & i
            If Range(pos) = "" Then     '如果单元格内容为空，则粘贴
                Range(pos).Select
                ActiveSheet.Paste
                GoTo OVER                '粘贴后就跳出for循环
            End If
        Next i
    End With
OVER:
    wk.Close savechanges:=True
    Set wk = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub

热心网友 时间：2023-10-25 10:44

这个套路容易看明白吧：
WorkBooks("1.xlsx").Sheets("sheet1").Range("a1:d5").Copy WorkBooks("2.xlsx").Sheets("sheet2").Range("a1:d5")
上面是复制单元格区域，如果需要复制工作表：
WorkBooks("1.xlsx").Sheets("sheet1").Copy After:=WorkBooks("2.xlsx").Sheets("sheet2")

热心网友 时间：2023-10-25 10:42

首先打开别的工作部-复制到打开工作簿-保存关闭

热心网友 时间：2023-10-25 10:43

录制一下就能得到代码

热心网友 时间：2023-10-25 10:44

这个套路容易看明白吧：
WorkBooks("1.xlsx").Sheets("sheet1").Range("a1:d5").Copy WorkBooks("2.xlsx").Sheets("sheet2").Range("a1:d5")
上面是复制单元格区域，如果需要复制工作表：
WorkBooks("1.xlsx").Sheets("sheet1").Copy After:=WorkBooks("2.xlsx").Sheets("sheet2")

热心网友 时间：2023-10-25 10:44

这个套路容易看明白吧：
WorkBooks("1.xlsx").Sheets("sheet1").Range("a1:d5").Copy WorkBooks("2.xlsx").Sheets("sheet2").Range("a1:d5")
上面是复制单元格区域，如果需要复制工作表：
WorkBooks("1.xlsx").Sheets("sheet1").Copy After:=WorkBooks("2.xlsx").Sheets("sheet2")