Microsoft Excel

Herbers Excel/VBA-Archiv

Kopieren | Herbers Excel-Forum


Betrifft: Kopieren von: Holger Niewald
Geschrieben am: 09.08.2012 14:23:53

Aus SAP exportiere ich Daten nach Excel. Hierbei wird die Arbeitsmappe X mit dem Tabellenblatt X erzeugt.

Wie kann ich per VBA folgendes erreichen:
Aus dem Tabellenblatt „X“ sollen zunächst die Zeilen 1-7 und die Spalten 1,2,8,9,15 gelöscht werden. Der dann verbleibende variierende Bereich soll kopiert und in die im gleichen Ordner bestehende, aber noch nicht geöffnete Mappe „Y“ , Tabellenblatt “Y“ an Position A7 eingefügt werden.
Dann soll die Ursprungsmappe X – da sie immer neu aus SAP erzeugt wird – gelöscht werden.

Es wäre schön, wenn mir aus dem Forum mit entsprechenden VBA-Code geholfen werden könnte.

  

Betrifft: AW: Kopieren von: Rudi Maintaire
Geschrieben am: 09.08.2012 15:09:19

Hallo,
teste mal:

Sub Import()
  Dim sFileX As String, sFileY As String
  Dim wkbX As Workbook, wkbY As Workbook, iColumn, arrColumns
  sFileX = "c:\temp\x.xls"
  sFileY = "c:\temp\y.xls"
  arrColumns = Array(15, 9, 8, 2, 1)
  Application.ScreenUpdating = False
  
  Set wkbX = Workbooks.Open(sFileX)
  Set wkbY = Workbooks.Open(sFileY)
  With wkbX.Sheets("X")
    .Rows("1:7").Delete
    For iColumn = 0 To UBound(arrColumns)
      .Columns(arrColumns(iColumn)).Delete
    Next
    .Range("A1").CurrentRegion.Copy
  End With
  With wkbY.Sheets("y")
    .Cells(Rows.Count, 1).End(xlUp).Offset(1).Paste
  End With
End Sub

Gruß
Rudi


  

Betrifft: AW: Kopieren, Ergänzung von: Rudi Maintaire
Geschrieben am: 09.08.2012 15:12:36

Hallo,
speichern und löschen vergessen.

Sub Import()
  Dim sFileX As String, sFileY As String
  Dim wkbX As Workbook, wkbY As Workbook, iColumn, arrColumns
  sFileX = "c:\temp\x.xls"
  sFileY = "c:\temp\y.xls"
  arrColumns = Array(15, 9, 8, 2, 1)
  Application.ScreenUpdating = False
  
  Set wkbX = Workbooks.Open(sFileX)
  Set wkbY = Workbooks.Open(sFileY)
  
  With wkbX
    With .Sheets("X")
      .Rows("1:7").Delete
      For iColumn = 0 To UBound(arrColumns)
        .Columns(arrColumns(iColumn)).Delete
      Next
      .Range("A1").CurrentRegion.Copy
    End With
    .Close False
  End With
  
  With wkbY
    With .Sheets("y")
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Paste
    End With
    .Close True
  End With
  
  Kill sFileX
End Sub

Gruß
Rudi


  

Betrifft: AW: Kopieren, Ergänzung von: Holger Niewald
Geschrieben am: 09.08.2012 17:22:16

Hallo Rudi,

vielen Dank für die schnelle Antwort. Ich werde das morgen im Büro sofort ausprobieren.

Gruß, Holger


  

Betrifft: AW: Kopieren, Ergänzung von: Holger Niewald
Geschrieben am: 10.08.2012 09:02:30

Hallo Rudi,
ich habe deinen Code an meine Daten angepasst. Leider bleibt der Ablauf mit der Meldung "Objekt unterstützt diese Eigenschaft oder Methode nicht" an dieser Stelle stehen:

.Cells(Rows.Count, 1).End(xlUp).Offset(1).Paste

Hast du da vielleicht einen Änderungsvorschlag? Danke.

Gruß, Holger


  

Betrifft: AW: Kopieren, Änderung von: Rudi Maintaire
Geschrieben am: 10.08.2012 09:08:27

Hallo,

Sub Import()
  Dim sFileX As String, sFileY As String
  Dim wkbX As Workbook, wkbY As Workbook, iColumn, arrColumns
  sFileX = "c:\temp\x.xls"
  sFileY = "c:\temp\y.xls"
  arrColumns = Array(15, 9, 8, 2, 1)
  Application.ScreenUpdating = False
  
  Set wkbX = Workbooks.Open(sFileX)
  Set wkbY = Workbooks.Open(sFileY)
  
  With wkbX
    With .Sheets("X")
      .Rows("1:7").Delete
      For iColumn = 0 To UBound(arrColumns)
        .Columns(arrColumns(iColumn)).Delete
      Next
      .Range("A1").CurrentRegion.Copy _
        wkbY.Sheets("y").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End With
    .Close False
  End With
  
  wkbY.Close True
  
  Kill sFileX
End Sub

Gruß
Rudi


  

Betrifft: AW: Kopieren, Änderung von: Holger Niewald
Geschrieben am: 10.08.2012 09:47:47

Hallo Rudi,
bleibt nach Änderung immer noch an der gleichen Stelle stehen.
Gruß, Holger


  

Betrifft: AW: Kopieren, Änderung von: Holger Niewald
Geschrieben am: 10.08.2012 09:48:28

Hallo Rudi,
bleibt nach Änderung immer noch an der gleichen Stelle stehen.
Gruß, Holger


  

Betrifft: nächster Versuch von: Rudi Maintaire
Geschrieben am: 10.08.2012 11:36:17

Hallo,
verstehe ich nicht.

Sub Import()
  Dim sFileX As String, sFileY As String
  Dim wkbX As Workbook, wkbY As Workbook, iColumn, arrColumns
  sFileX = "c:\temp\x.xls"
  sFileY = "c:\temp\y.xls"
  arrColumns = Array(15, 9, 8, 2, 1)
  Application.ScreenUpdating = False
  
  Set wkbX = Workbooks.Open(sFileX)
  Set wkbY = Workbooks.Open(sFileY)
  
  With wkbX
    With .Sheets("X")
      .Rows("1:7").Delete
      For iColumn = 0 To UBound(arrColumns)
        .Columns(arrColumns(iColumn)).Delete
      Next
      .Range("A1").CurrentRegion.Copy
    End With
    .Close False
  End With
  
  With wkbY
    With .Sheets("Y")
      .Paste .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End With
    .Close True
  End With
  
  Application.CutCopyMode = False
  Kill sFileX
End Sub

Gruß
Rudi


Beiträge aus den Excel-Beispielen zum Thema "Kopieren"